4 |
;; 2005 Free Software Foundation, Inc. |
;; 2005 Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Author: Daiki Ueno <ueno@unixuser.org> |
;; Author: Daiki Ueno <ueno@unixuser.org> |
7 |
|
;; Symmetric encryption added by: Sascha Wilde <wilde@sha-bang.de> |
8 |
;; Created: 1999/10/28 |
;; Created: 1999/10/28 |
9 |
;; Keywords: PGP, OpenPGP, GnuPG |
;; Keywords: PGP, OpenPGP, GnuPG |
10 |
|
|
97 |
(delete-file output-file-name)) |
(delete-file output-file-name)) |
98 |
(set-default-file-modes orig-mode)))) |
(set-default-file-modes orig-mode)))) |
99 |
|
|
100 |
(defun pgg-gpg-possibly-cache-passphrase (passphrase &optional key) |
(defun pgg-gpg-possibly-cache-passphrase (passphrase &optional key notruncate) |
101 |
(if (and pgg-cache-passphrase |
(if (and pgg-cache-passphrase |
102 |
(progn |
(progn |
103 |
(goto-char (point-min)) |
(goto-char (point-min)) |
104 |
(re-search-forward "^\\[GNUPG:] \\(GOOD_PASSPHRASE\\>\\)\\|\\(SIG_CREATED\\)" nil t))) |
(re-search-forward "^\\[GNUPG:] \\(GOOD_PASSPHRASE\\>\\)\\|\\(SIG_CREATED\\)" nil t))) |
105 |
(pgg-add-passphrase-cache |
(pgg-add-passphrase-to-cache |
106 |
(or key |
(or key |
107 |
(progn |
(progn |
108 |
(goto-char (point-min)) |
(goto-char (point-min)) |
109 |
(if (re-search-forward |
(if (re-search-forward |
110 |
"^\\[GNUPG:] NEED_PASSPHRASE\\(_PIN\\)? \\w+ ?\\w*" nil t) |
"^\\[GNUPG:] NEED_PASSPHRASE\\(_PIN\\)? \\w+ ?\\w*" nil t) |
111 |
(substring (match-string 0) -8)))) |
(substring (match-string 0) -8)))) |
112 |
passphrase))) |
passphrase |
113 |
|
notruncate))) |
114 |
|
|
115 |
(defvar pgg-gpg-all-secret-keys 'unknown) |
(defvar pgg-gpg-all-secret-keys 'unknown) |
116 |
|
|
141 |
nil t) |
nil t) |
142 |
(substring (match-string 2) 8))))) |
(substring (match-string 2) 8))))) |
143 |
|
|
144 |
(defun pgg-gpg-encrypt-region (start end recipients &optional sign) |
(defun pgg-gpg-lookup-key-owner (string &optional all) |
145 |
|
"Search keys associated with STRING and return owner of identified key. |
146 |
|
|
147 |
|
The value may be just the bare key id, or it may be a combination of the |
148 |
|
user name associated with the key and the key id, with the key id enclosed |
149 |
|
in \"<...>\" angle brackets. |
150 |
|
|
151 |
|
Optional ALL non-nil means search all keys, including secret keys." |
152 |
|
(let ((args (list "--with-colons" "--no-greeting" "--batch" |
153 |
|
(if all "--list-secret-keys" "--list-keys") |
154 |
|
string)) |
155 |
|
(key-regexp (concat "^\\(sec\\|pub\\)" |
156 |
|
":[^:]*:[^:]*:[^:]*:\\([^:]*\\):[^:]*" |
157 |
|
":[^:]*:[^:]*:[^:]*:\\([^:]*\\):")) |
158 |
|
) |
159 |
|
(with-temp-buffer |
160 |
|
(apply #'call-process pgg-gpg-program nil t nil args) |
161 |
|
(goto-char (point-min)) |
162 |
|
(if (re-search-forward key-regexp |
163 |
|
nil t) |
164 |
|
(match-string 3))))) |
165 |
|
|
166 |
|
(defun pgg-gpg-key-id-from-key-owner (key-owner) |
167 |
|
(cond ((not key-owner) nil) |
168 |
|
;; Extract bare key id from outermost paired angle brackets, if any: |
169 |
|
((string-match "[^<]*<\\(.+\\)>[^>]*" key-owner) |
170 |
|
(substring key-owner (match-beginning 1)(match-end 1))) |
171 |
|
(key-owner)) |
172 |
|
) |
173 |
|
|
174 |
|
(defun pgg-gpg-encrypt-region (start end recipients &optional sign passphrase) |
175 |
"Encrypt the current region between START and END. |
"Encrypt the current region between START and END. |
176 |
If optional argument SIGN is non-nil, do a combined sign and encrypt." |
|
177 |
|
If optional argument SIGN is non-nil, do a combined sign and encrypt. |
178 |
|
|
179 |
|
If optional PASSPHRASE is not specified, it will be obtained from the |
180 |
|
passphrase cache or user." |
181 |
(let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) |
(let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) |
182 |
(passphrase |
(passphrase (or passphrase |
183 |
(when sign |
(when sign |
184 |
(pgg-read-passphrase |
(pgg-read-passphrase |
185 |
(format "GnuPG passphrase for %s: " pgg-gpg-user-id) |
(format "GnuPG passphrase for %s: " |
186 |
pgg-gpg-user-id))) |
pgg-gpg-user-id) |
187 |
|
pgg-gpg-user-id)))) |
188 |
(args |
(args |
189 |
(append |
(append |
190 |
(list "--batch" "--armor" "--always-trust" "--encrypt") |
(list "--batch" "--textmode" "--armor" "--always-trust" "--encrypt") |
191 |
(if sign (list "--sign" "--local-user" pgg-gpg-user-id)) |
(if sign (list "--sign" "--local-user" pgg-gpg-user-id)) |
192 |
(if recipients |
(if recipients |
193 |
(apply #'nconc |
(apply #'nconc |
206 |
(pgg-gpg-possibly-cache-passphrase passphrase))) |
(pgg-gpg-possibly-cache-passphrase passphrase))) |
207 |
(pgg-process-when-success))) |
(pgg-process-when-success))) |
208 |
|
|
209 |
(defun pgg-gpg-decrypt-region (start end) |
(defun pgg-gpg-encrypt-symmetric-region (start end &optional passphrase) |
210 |
"Decrypt the current region between START and END." |
"Encrypt the current region between START and END with symmetric cipher. |
211 |
|
|
212 |
|
If optional PASSPHRASE is not specified, it will be obtained from the |
213 |
|
passphrase cache or user." |
214 |
|
(let* ((passphrase (or passphrase |
215 |
|
(pgg-read-passphrase |
216 |
|
"GnuPG passphrase for symmetric encryption: "))) |
217 |
|
(args |
218 |
|
(append (list "--batch" "--textmode" "--armor" "--symmetric" )))) |
219 |
|
(pgg-as-lbt start end 'CRLF |
220 |
|
(pgg-gpg-process-region start end passphrase pgg-gpg-program args)) |
221 |
|
(pgg-process-when-success))) |
222 |
|
|
223 |
|
(defun pgg-gpg-decrypt-region (start end &optional passphrase) |
224 |
|
"Decrypt the current region between START and END. |
225 |
|
|
226 |
|
If optional PASSPHRASE is not specified, it will be obtained from the |
227 |
|
passphrase cache or user." |
228 |
(let* ((current-buffer (current-buffer)) |
(let* ((current-buffer (current-buffer)) |
229 |
(message-keys (with-temp-buffer |
(message-keys (with-temp-buffer |
230 |
(insert-buffer-substring current-buffer) |
(insert-buffer-substring current-buffer) |
231 |
(pgg-decode-armor-region (point-min) (point-max)))) |
(pgg-decode-armor-region (point-min) (point-max)))) |
232 |
(secret-keys (pgg-gpg-lookup-all-secret-keys)) |
(secret-keys (pgg-gpg-lookup-all-secret-keys)) |
233 |
|
;; XXX the user is stuck if they need to use the passphrase for |
234 |
|
;; any but the first secret key for which the message is |
235 |
|
;; encrypted. ideally, we would incrementally give them a |
236 |
|
;; chance with subsequent keys each time they fail with one. |
237 |
(key (pgg-gpg-select-matching-key message-keys secret-keys)) |
(key (pgg-gpg-select-matching-key message-keys secret-keys)) |
238 |
(pgg-gpg-user-id (or key pgg-gpg-user-id pgg-default-user-id)) |
(key-owner (and key (pgg-gpg-lookup-key-owner key t))) |
239 |
(passphrase |
(key-id (pgg-gpg-key-id-from-key-owner key-owner)) |
240 |
(pgg-read-passphrase |
(pgg-gpg-user-id (or key-id key |
241 |
(format "GnuPG passphrase for %s: " pgg-gpg-user-id) |
pgg-gpg-user-id pgg-default-user-id)) |
242 |
pgg-gpg-user-id)) |
(passphrase (or passphrase |
243 |
|
(pgg-read-passphrase |
244 |
|
(format (if (pgg-gpg-symmetric-key-p message-keys) |
245 |
|
"Passphrase for symmetric decryption: " |
246 |
|
"GnuPG passphrase for %s: ") |
247 |
|
(or key-owner "??")) |
248 |
|
pgg-gpg-user-id))) |
249 |
(args '("--batch" "--decrypt"))) |
(args '("--batch" "--decrypt"))) |
250 |
(pgg-gpg-process-region start end passphrase pgg-gpg-program args) |
(pgg-gpg-process-region start end passphrase pgg-gpg-program args) |
251 |
(with-current-buffer pgg-errors-buffer |
(with-current-buffer pgg-errors-buffer |
253 |
(goto-char (point-min)) |
(goto-char (point-min)) |
254 |
(re-search-forward "^\\[GNUPG:] DECRYPTION_OKAY\\>" nil t)))) |
(re-search-forward "^\\[GNUPG:] DECRYPTION_OKAY\\>" nil t)))) |
255 |
|
|
256 |
|
;;;###autoload |
257 |
|
(defun pgg-gpg-symmetric-key-p (message-keys) |
258 |
|
"True if decoded armor MESSAGE-KEYS has symmetric encryption indicator." |
259 |
|
(let (result) |
260 |
|
(dolist (key message-keys result) |
261 |
|
(when (and (eq (car key) 3) |
262 |
|
(member '(symmetric-key-algorithm) key)) |
263 |
|
(setq result key))))) |
264 |
|
|
265 |
(defun pgg-gpg-select-matching-key (message-keys secret-keys) |
(defun pgg-gpg-select-matching-key (message-keys secret-keys) |
266 |
"Choose a key from MESSAGE-KEYS that matches one of the keys in SECRET-KEYS." |
"Choose a key from MESSAGE-KEYS that matches one of the keys in SECRET-KEYS." |
267 |
(loop for message-key in message-keys |
(loop for message-key in message-keys |
268 |
for message-key-id = (and (equal (car message-key) 1) |
for message-key-id = (and (equal (car message-key) 1) |
269 |
(cdr (assq 'key-identifier message-key))) |
(cdr (assq 'key-identifier |
270 |
|
(cdr message-key)))) |
271 |
for key = (and message-key-id (pgg-lookup-key message-key-id 'encrypt)) |
for key = (and message-key-id (pgg-lookup-key message-key-id 'encrypt)) |
272 |
when (and key (member key secret-keys)) return key)) |
when (and key (member key secret-keys)) return key)) |
273 |
|
|
274 |
(defun pgg-gpg-sign-region (start end &optional cleartext) |
(defun pgg-gpg-sign-region (start end &optional cleartext passphrase) |
275 |
"Make detached signature from text between START and END." |
"Make detached signature from text between START and END." |
276 |
(let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) |
(let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) |
277 |
(passphrase |
(passphrase (or passphrase |
278 |
(pgg-read-passphrase |
(pgg-read-passphrase |
279 |
(format "GnuPG passphrase for %s: " pgg-gpg-user-id) |
(format "GnuPG passphrase for %s: " pgg-gpg-user-id) |
280 |
pgg-gpg-user-id)) |
pgg-gpg-user-id))) |
281 |
(args |
(args |
282 |
(list (if cleartext "--clearsign" "--detach-sign") |
(list (if cleartext "--clearsign" "--detach-sign") |
283 |
"--armor" "--batch" "--verbose" |
"--armor" "--batch" "--verbose" |