1 ;;; mime-pgp.el --- mime-view internal methods for either PGP or GnuPG.
3 ;; Copyright (C) 1995,1996,1997,1998,1999 MORIOKA Tomohiko
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
6 ;; Katsumi Yamaoka <yamaoka@jpl.org>
8 ;; Renamed: 1997/2/27 from tm-pgp.el
9 ;; Keywords: PGP, GnuPG, security, MIME, multimedia, mail, news
11 ;; This file is part of SEMI (Secure Emacs MIME Interface).
13 ;; This program is free software; you can redistribute it and/or
14 ;; modify it under the terms of the GNU General Public License as
15 ;; published by the Free Software Foundation; either version 2, or (at
16 ;; your option) any later version.
18 ;; This program is distributed in the hope that it will be useful, but
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 ;; General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA.
30 ;; This module is based on
32 ;; [security-multipart] RFC 1847: "Security Multiparts for MIME:
33 ;; Multipart/Signed and Multipart/Encrypted" by
34 ;; Jim Galvin <galvin@tis.com>, Sandy Murphy <sandy@tis.com>,
35 ;; Steve Crocker <crocker@cybercash.com> and
36 ;; Ned Freed <ned@innosoft.com> (1995/10)
38 ;; [PGP/MIME] RFC 2015: "MIME Security with Pretty Good Privacy
39 ;; (PGP)" by Michael Elkins <elkins@aero.org> (1996/6)
41 ;; [PGP-kazu] draft-kazu-pgp-mime-00.txt: "PGP MIME Integration"
42 ;; by Kazuhiko Yamamoto <kazu@is.aist-nara.ac.jp> (1995/10;
45 ;; [OpenPGP/MIME] draft-yamamoto-openpgp-mime-00.txt: "MIME
46 ;; Security with OpenPGP (OpenPGP/MIME)" by Kazuhiko YAMAMOTO
47 ;; <kazu@iijlab.net> (1998/1)
56 ;;; @ Internal method for multipart/signed
58 ;;; It is based on RFC 1847 (security-multipart).
60 (defun mime-verify-multipart/signed (entity situation)
61 "Internal method to verify multipart/signed."
63 (nth 1 (mime-entity-children entity)) ; entity-info of signature
64 (list (assq 'mode situation)) ; play-mode
68 ;;; @ internal method for application/pgp
70 ;;; It is based on draft-kazu-pgp-mime-00.txt (PGP-kazu).
72 (defun mime-view-application/pgp (entity situation)
73 (let* ((p-win (or (get-buffer-window (current-buffer))
74 (get-largest-window)))
76 (format "%s-%s" (buffer-name) (mime-entity-number entity)))
77 (mother (current-buffer))
79 (set-buffer (get-buffer-create new-name))
81 (mime-insert-entity entity)
83 (goto-char (point-min))
84 (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t))
85 (funcall (pgp-function 'verify))
86 (goto-char (point-min))
90 (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+\n")
91 (search-forward "\n\n")
94 (and (re-search-forward "^-+BEGIN PGP SIGNATURE-+")
97 (goto-char (point-min))
98 (while (re-search-forward "^- -" nil t)
101 (setq representation-type (if (mime-entity-cooked-p entity)
105 (goto-char (point-min))
106 (re-search-forward "^-+BEGIN PGP MESSAGE-+$" nil t))
107 (as-binary-process (funcall (pgp-function 'decrypt)))
108 (goto-char (point-min))
109 (delete-region (point-min)
111 (search-forward "\n\n")
113 (setq representation-type 'binary)
115 (setq major-mode 'mime-show-message-mode)
116 (save-window-excursion (mime-view-buffer nil nil mother
117 nil representation-type))
118 (set-window-buffer p-win mime-preview-buffer)
122 ;;; @ Internal method for application/pgp-signature
124 ;;; It is based on RFC 2015 (PGP/MIME) and
125 ;;; draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME).
128 (defcustom mime-pgp-command-alist '((gpg . "gpg")
131 "Alist of the schemes and the name of the commands. Valid SCHEMEs are:
134 pgp50 - PGP version 5.0i.
135 pgp - PGP version 2.6.
137 COMMAND for `pgp50' must *NOT* have a suffix, like neither \"pgpe\", \"pgpk\",
138 \"pgps\" nor \"pgpv\"."
140 :type '(repeat (cons :format "%v"
141 (choice (choice-item :tag "GnuPG" gpg)
142 (choice-item :tag "PGP 5.0i" pgp50)
143 (choice-item :tag "PGP 2.6" pgp))
144 (string :tag "Command"))))
146 (defcustom mime-pgp-default-language-alist '((gpg . nil)
149 "Alist of the schemes and the symbol of languages. It should be ISO 639
150 2 letter language code such as en, ja, ... Each element looks like
151 \(SCHEME . SYMBOL). See also `mime-pgp-command-alist' for valid SCHEMEs."
153 :type '(repeat (cons :format "%v"
154 (choice (choice-item :tag "GnuPG" gpg)
155 (choice-item :tag "PGP 5.0i" pgp50)
156 (choice-item :tag "PGP 2.6" pgp))
157 (symbol :tag "Language"))))
159 (defcustom mime-pgp-good-signature-regexp-alist
161 (nil "Good signature from.*$" nil)
164 (us "Good signature made .* by key:$"
165 mime-pgp-good-signature-post-function-pgp50-us)
168 (en "Good signature from user.*$" nil)
170 "Alist of the schemes and alist of the languages and the regexps for
171 detecting ``Good signature''. The optional symbol of the post processing
172 function for arranging the output message can be specified in each element.
173 It will be called just after re-search is done successfully, and it is
174 expected that the function returns a string for messaging."
176 :type '(repeat (cons :format "%v"
177 (choice (choice-item :tag "GnuPG" gpg)
178 (choice-item :tag "PGP 5.0i" pgp50)
179 (choice-item :tag "PGP 2.6" pgp))
180 (repeat (list :format "%v"
181 (symbol :tag "Language")
182 (regexp :tag "Regexp")
183 (function :tag "Post Function"))))))
185 (defcustom mime-pgp-bad-signature-regexp-alist
187 (nil "BAD signature from.*$" nil)
190 (us "BAD signature made .* by key:$"
191 mime-pgp-bad-signature-post-function-pgp50-us)
194 (en "Bad signature from user.*$" nil)
196 "Alist of the schemes and alist of the languages and the regexps for
197 detecting ``BAD signature''. The optional symbol of the post processing
198 function for arranging the output message can be specified in each element.
199 It will be called just after re-search is done successfully, and it is
200 expected that the function returns a string for messaging."
202 :type '(repeat (cons :format "%v"
203 (choice (choice-item :tag "GnuPG" gpg)
204 (choice-item :tag "PGP 5.0i" pgp50)
205 (choice-item :tag "PGP 2.6" pgp))
206 (repeat (list :format "%v"
207 (symbol :tag "Language")
208 (regexp :tag "Regexp")
209 (function :tag "Post Function"))))))
211 (defcustom mime-pgp-key-expected-regexp-alist
215 "key ID \\(\\S +\\)\ngpg: Can't check signature: public key not found")
218 (us . "Signature by unknown keyid: 0x\\(\\S +\\)")
221 (en . "Key matching expected Key ID \\(\\S +\\) not found")
223 "Alist of the schemes and alist of the languages and regexps for detecting
226 :type '(repeat (cons :format "%v"
227 (choice (choice-item :tag "GnuPG" gpg)
228 (choice-item :tag "PGP 5.0i" pgp50)
229 (choice-item :tag "PGP 2.6" pgp))
230 (repeat (cons :format "%v"
231 (symbol :tag "Language")
232 (regexp :tag "Regexp"))))))
234 (defmacro mime-pgp-command (&optional suffix)
235 "Return a suitable command. SUFFIX should be either \"e\", \"k\", \"s\"
236 or \"v\" for choosing a command of PGP 5.0i."
237 (` (let ((command (cdr (assq pgp-version mime-pgp-command-alist))))
240 (if (eq 'pgp50 pgp-version)
241 (setq command (format "%s%s" command (, suffix))))
242 (exec-installed-p command)))
244 (error "Please specify the valid command name for `%s'."
245 (or pgp-version 'pgp-version))))))
247 (defmacro mime-pgp-default-language ()
248 "Return a symbol of language."
249 '(cond ((eq 'gpg pgp-version)
251 ((eq 'pgp50 pgp-version)
252 (or (cdr (assq pgp-version mime-pgp-default-language-alist)) 'us)
255 (or (cdr (assq pgp-version mime-pgp-default-language-alist)) 'en)
258 (defmacro mime-pgp-good-signature-regexp ()
259 "Return a regexp to detect ``Good signature''."
262 (mime-pgp-default-language)
263 (cdr (assq pgp-version mime-pgp-good-signature-regexp-alist))
266 (defmacro mime-pgp-good-signature-post-function ()
267 "Return a post processing function for arranging the message for
271 (mime-pgp-default-language)
272 (cdr (assq pgp-version mime-pgp-good-signature-regexp-alist))
275 (defmacro mime-pgp-bad-signature-regexp ()
276 "Return a regexp to detect ``BAD signature''."
279 (mime-pgp-default-language)
280 (cdr (assq pgp-version mime-pgp-bad-signature-regexp-alist))
283 (defmacro mime-pgp-bad-signature-post-function ()
284 "Return a post processing function for arranging the message for
288 (mime-pgp-default-language)
289 (cdr (assq pgp-version mime-pgp-bad-signature-regexp-alist))
292 (defmacro mime-pgp-key-expected-regexp ()
293 "Return a regexp to detect ``Key expected''."
294 '(cdr (assq (mime-pgp-default-language)
295 (cdr (assq pgp-version mime-pgp-key-expected-regexp-alist))
298 (defun mime-pgp-detect-version (entity)
299 "Detect PGP version from detached signature."
301 (mime-insert-entity-content entity)
302 (std11-narrow-to-header)
303 (let ((version (std11-fetch-field "Version")))
306 ((string-match "GnuPG" version)
308 ((string-match "5\\.0i" version)
310 ((string-match "2\\.6" version)
315 (defun mime-pgp-check-signature (output-buffer orig-file)
316 (with-current-buffer output-buffer
318 (setq truncate-lines t))
319 (let* ((lang (mime-pgp-default-language))
320 (command (mime-pgp-command 'v))
321 (args (cond ((eq 'gpg pgp-version)
322 (list "--batch" "--verify"
323 (concat orig-file ".sig"))
325 ((eq 'pgp50 pgp-version)
327 (format "+language=%s" lang)
328 (concat orig-file ".sig"))
330 ((eq 'pgp pgp-version)
331 (list (format "+language=%s" lang) orig-file))
333 (good-regexp (mime-pgp-good-signature-regexp))
334 (good-post-function (mime-pgp-good-signature-post-function))
335 (bad-regexp (mime-pgp-bad-signature-regexp))
336 (bad-post-function (mime-pgp-bad-signature-post-function))
339 (setq status (apply 'call-process-region (point-min) (point-max)
340 command nil output-buffer nil args)
342 (with-current-buffer output-buffer
343 (goto-char (point-min))
344 (cond ((not (stringp good-regexp))
345 (message "Please specify right regexp for specified language")
347 ((and (zerop status) (re-search-forward good-regexp nil t))
348 (message (if good-post-function
349 (funcall good-post-function)
350 (buffer-substring (match-beginning 0)
352 (goto-char (point-min))
354 ((not (stringp bad-regexp))
355 (message "Please specify right regexp for specified language")
357 ((re-search-forward bad-regexp nil t)
358 (message (if bad-post-function
359 (funcall bad-post-function)
360 (buffer-substring (match-beginning 0)
362 (goto-char (point-min))
365 ;; Returns nil in order for attempt to fetch key.
369 (defmacro mime-pgp-parse-verify-error (&rest forms)
370 (` (with-current-buffer mime-echo-buffer-name
371 (goto-char (point-min))
373 (let ((regexp (mime-pgp-key-expected-regexp)))
375 ((not (stringp regexp))
376 (message "Please specify right regexp for specified language")
379 ((re-search-forward regexp nil t)
380 (concat "0x" (buffer-substring-no-properties
381 (match-beginning 1) (match-end 1)))
383 (goto-char (point-min))
386 (get-buffer-window mime-echo-buffer-name) (point))
389 (defun mime-pgp-parse-verify-error-for-gpg ()
390 "Subroutine used for parsing verify error with GnuPG. Returns expected
391 key-ID if it is found."
392 (mime-pgp-parse-verify-error)
395 (defun mime-pgp-parse-verify-error-for-pgp50 ()
396 "Subroutine used for parsing verify error with PGP 5.0i. Returns expected
397 key-ID if it is found."
398 (mime-pgp-parse-verify-error
402 (defun mime-pgp-parse-verify-error-for-pgp ()
403 "Subroutine used for parsing verify error with PGP 2.6. Returns expected
404 key-ID if it is found."
405 (mime-pgp-parse-verify-error
406 (if (search-forward "\C-g" nil t)
407 (goto-char (match-beginning 0))
411 (defun mime-verify-application/pgp-signature (entity situation)
412 "Internal method to check PGP/MIME signature."
413 (let* ((entity-node-id (mime-entity-node-id entity))
414 (mother (mime-entity-parent entity))
415 (knum (car entity-node-id))
419 (orig-entity (nth onum (mime-entity-children mother)))
420 (basename (expand-file-name "tm" temporary-file-directory))
421 (orig-file (make-temp-name basename))
422 (sig-file (concat orig-file ".sig"))
423 (pgp-version (mime-pgp-detect-version entity))
424 (parser (intern (format "mime-pgp-parse-verify-error-for-%s"
427 (mime-write-entity orig-entity orig-file)
428 (save-current-buffer (mime-show-echo-buffer))
429 (mime-write-entity-content entity sig-file)
430 (message "Checking signature...")
433 (if (setq done (mime-pgp-check-signature
434 mime-echo-buffer-name orig-file))
435 (let ((other-window-scroll-buffer mime-echo-buffer-name))
437 (cdr (assq pgp-version
438 '((gpg . 0) (pgp50 . 1) (pgp . 10)))))
442 (setq pgp-id (funcall parser))
443 (y-or-n-p (format "Key %s not found; attempt to fetch? "
446 (funcall (pgp-function 'fetch-key) (cons nil pgp-id))
449 (message "Can't check signature")
451 (delete-file orig-file)
452 (delete-file sig-file)
455 (defun mime-pgp-good-signature-post-function-pgp50-us ()
457 (looking-at "\\s +\\(.+\\)$")
458 (format "Good signature from %s" (match-string 1)))
460 (defun mime-pgp-bad-signature-post-function-pgp50-us ()
462 (looking-at "\\s +\\(.+\\)$")
463 (format "BAD signature from %s" (match-string 1)))
466 ;;; @ Internal method for application/pgp-encrypted
468 ;;; It is based on RFC 2015 (PGP/MIME) and
469 ;;; draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME).
471 (defun mime-decrypt-application/pgp-encrypted (entity situation)
472 (let* ((entity-node-id (mime-entity-node-id entity))
473 (mother (mime-entity-parent entity))
474 (knum (car entity-node-id))
478 (orig-entity (nth onum (mime-entity-children mother)))
479 (pgp-version (mime-pgp-detect-version orig-entity)))
480 (mime-view-application/pgp orig-entity situation)
484 ;;; @ Internal method for application/pgp-keys
486 ;;; It is based on RFC 2015 (PGP/MIME) and
487 ;;; draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME).
489 (defun mime-add-application/pgp-keys (entity situation)
490 (let* ((start (mime-entity-point-min entity))
491 (end (mime-entity-point-max entity))
492 (entity-number (mime-raw-point-to-entity-number start))
493 (new-name (format "%s-%s" (buffer-name) entity-number))
494 (encoding (cdr (assq 'encoding situation)))
496 (setq str (buffer-substring start end))
497 (switch-to-buffer new-name)
498 (setq buffer-read-only nil)
501 (goto-char (point-min))
502 (if (re-search-forward "^\n" nil t)
503 (delete-region (point-min) (match-end 0))
505 (mime-decode-region (point-min)(point-max) encoding)
506 (funcall (pgp-function 'snarf-keys))
507 (kill-buffer (current-buffer))
516 (run-hooks 'mime-pgp-load-hook)
518 ;;; mime-pgp.el ends here