1 ;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP)
2 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005
3 ;; Free Software Foundation, Inc.
5 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
6 ;; Keywords: PGP MIME MML
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
12 ;; by the Free Software Foundation; either version 2, or (at your
13 ;; option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; 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., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, USA.
27 ;; RFC 2015 is updated by RFC 3156, this file should be compatible
32 (eval-when-compile (require 'cl))
37 (defvar mml2015-use (or
40 ;; Avoid the "Recursive load suspected" error
42 (let ((recursive-load-depth-limit 100))
44 (and (fboundp 'pgg-sign-region)
49 (and (fboundp 'gpg-sign-detached)
53 (and (fboundp 'mc-encrypt-generic)
54 (fboundp 'mc-sign-generic)
55 (fboundp 'mc-cleanup-recipient-headers)
57 "The package used for PGP/MIME.
58 Valid packages include `pgg', `gpg' and `mailcrypt'.")
60 ;; Something is not RFC2015.
61 (defvar mml2015-function-alist
62 '((mailcrypt mml2015-mailcrypt-sign
63 mml2015-mailcrypt-encrypt
64 mml2015-mailcrypt-verify
65 mml2015-mailcrypt-decrypt
66 mml2015-mailcrypt-clear-verify
67 mml2015-mailcrypt-clear-decrypt)
72 mml2015-gpg-clear-verify
73 mml2015-gpg-clear-decrypt)
78 mml2015-pgg-clear-verify
79 mml2015-pgg-clear-decrypt))
80 "Alist of PGP/MIME functions.")
82 (defvar mml2015-result-buffer nil)
84 (defcustom mml2015-unabbrev-trust-alist
85 '(("TRUST_UNDEFINED" . nil)
87 ("TRUST_MARGINAL" . t)
89 ("TRUST_ULTIMATE" . t))
90 "Map GnuPG trust output values to a boolean saying if you trust the key."
93 :type '(repeat (cons (regexp :tag "GnuPG output regexp")
94 (boolean :tag "Trust key"))))
99 (autoload 'mailcrypt-decrypt "mailcrypt")
100 (autoload 'mailcrypt-verify "mailcrypt")
101 (autoload 'mc-pgp-always-sign "mailcrypt")
102 (autoload 'mc-encrypt-generic "mc-toplev")
103 (autoload 'mc-cleanup-recipient-headers "mc-toplev")
104 (autoload 'mc-sign-generic "mc-toplev"))
107 (defvar mc-default-scheme)
110 (defvar mml2015-decrypt-function 'mailcrypt-decrypt)
111 (defvar mml2015-verify-function 'mailcrypt-verify)
113 (defun mml2015-format-error (err)
114 (if (stringp (cadr err))
116 (format "%S" (cdr err))))
118 (defun mml2015-mailcrypt-decrypt (handle ctl)
120 (let (child handles result)
121 (unless (setq child (mm-find-part-by-type
123 "application/octet-stream" nil t))
124 (mm-set-handle-multipart-parameter
125 mm-security-handle 'gnus-info "Corrupted")
126 (throw 'error handle))
128 (mm-insert-part child)
131 (funcall mml2015-decrypt-function)
133 (mm-set-handle-multipart-parameter
134 mm-security-handle 'gnus-details (mml2015-format-error err))
137 (mm-set-handle-multipart-parameter
138 mm-security-handle 'gnus-details "Quit.")
141 (mm-set-handle-multipart-parameter
142 mm-security-handle 'gnus-info "Failed")
143 (throw 'error handle))
144 (setq handles (mm-dissect-buffer t)))
145 (mm-destroy-parts handle)
146 (mm-set-handle-multipart-parameter
147 mm-security-handle 'gnus-info
149 (let ((sig (with-current-buffer mml2015-result-buffer
150 (mml2015-gpg-extract-signature-details))))
151 (concat ", Signer: " sig))))
152 (if (listp (car handles))
156 (defun mml2015-mailcrypt-clear-decrypt ()
160 (funcall mml2015-decrypt-function)
162 (mm-set-handle-multipart-parameter
163 mm-security-handle 'gnus-details (mml2015-format-error err))
166 (mm-set-handle-multipart-parameter
167 mm-security-handle 'gnus-details "Quit.")
170 (mm-set-handle-multipart-parameter
171 mm-security-handle 'gnus-info "OK")
172 (mm-set-handle-multipart-parameter
173 mm-security-handle 'gnus-info "Failed"))))
175 (defun mml2015-fix-micalg (alg)
177 ;; Mutt/1.2.5i has seen sending micalg=php-sha1
178 (upcase (if (string-match "^p[gh]p-" alg)
179 (substring alg (match-end 0))
182 (defun mml2015-mailcrypt-verify (handle ctl)
185 (unless (setq part (mm-find-raw-part-by-type
186 ctl (or (mm-handle-multipart-ctl-parameter
188 "application/pgp-signature")
190 (mm-set-handle-multipart-parameter
191 mm-security-handle 'gnus-info "Corrupted")
192 (throw 'error handle))
194 (insert "-----BEGIN PGP SIGNED MESSAGE-----\n")
195 (insert (format "Hash: %s\n\n"
196 (or (mml2015-fix-micalg
197 (mm-handle-multipart-ctl-parameter
201 (narrow-to-region (point) (point))
203 (goto-char (point-min))
205 (if (looking-at "^-")
208 (unless (setq part (mm-find-part-by-type
209 (cdr handle) "application/pgp-signature" nil t))
210 (mm-set-handle-multipart-parameter
211 mm-security-handle 'gnus-info "Corrupted")
212 (throw 'error handle))
214 (narrow-to-region (point) (point))
215 (mm-insert-part part)
216 (goto-char (point-min))
217 (if (re-search-forward "^-----BEGIN PGP [^-]+-----\r?$" nil t)
218 (replace-match "-----BEGIN PGP SIGNATURE-----" t t))
219 (if (re-search-forward "^-----END PGP [^-]+-----\r?$" nil t)
220 (replace-match "-----END PGP SIGNATURE-----" t t)))
221 (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
222 (unless (condition-case err
224 (funcall mml2015-verify-function)
225 (if (get-buffer " *mailcrypt stderr temp")
226 (mm-set-handle-multipart-parameter
227 mm-security-handle 'gnus-details
228 (with-current-buffer " *mailcrypt stderr temp"
230 (if (get-buffer " *mailcrypt stdout temp")
231 (kill-buffer " *mailcrypt stdout temp"))
232 (if (get-buffer " *mailcrypt stderr temp")
233 (kill-buffer " *mailcrypt stderr temp"))
234 (if (get-buffer " *mailcrypt status temp")
235 (kill-buffer " *mailcrypt status temp"))
236 (if (get-buffer mc-gpg-debug-buffer)
237 (kill-buffer mc-gpg-debug-buffer)))
239 (mm-set-handle-multipart-parameter
240 mm-security-handle 'gnus-details (mml2015-format-error err))
243 (mm-set-handle-multipart-parameter
244 mm-security-handle 'gnus-details "Quit.")
246 (mm-set-handle-multipart-parameter
247 mm-security-handle 'gnus-info "Failed")
248 (throw 'error handle))))
249 (mm-set-handle-multipart-parameter
250 mm-security-handle 'gnus-info "OK")
253 (defun mml2015-mailcrypt-clear-verify ()
254 (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
255 (if (condition-case err
257 (funcall mml2015-verify-function)
258 (if (get-buffer " *mailcrypt stderr temp")
259 (mm-set-handle-multipart-parameter
260 mm-security-handle 'gnus-details
261 (with-current-buffer " *mailcrypt stderr temp"
263 (if (get-buffer " *mailcrypt stdout temp")
264 (kill-buffer " *mailcrypt stdout temp"))
265 (if (get-buffer " *mailcrypt stderr temp")
266 (kill-buffer " *mailcrypt stderr temp"))
267 (if (get-buffer " *mailcrypt status temp")
268 (kill-buffer " *mailcrypt status temp"))
269 (if (get-buffer mc-gpg-debug-buffer)
270 (kill-buffer mc-gpg-debug-buffer)))
272 (mm-set-handle-multipart-parameter
273 mm-security-handle 'gnus-details (mml2015-format-error err))
276 (mm-set-handle-multipart-parameter
277 mm-security-handle 'gnus-details "Quit.")
279 (mm-set-handle-multipart-parameter
280 mm-security-handle 'gnus-info "OK")
281 (mm-set-handle-multipart-parameter
282 mm-security-handle 'gnus-info "Failed"))))
284 (defun mml2015-mailcrypt-sign (cont)
285 (mc-sign-generic (message-options-get 'message-sender)
287 (let ((boundary (mml-compute-boundary cont))
289 (goto-char (point-min))
290 (unless (re-search-forward "^-----BEGIN PGP SIGNED MESSAGE-----\r?$" nil t)
291 (error "Cannot find signed begin line"))
292 (goto-char (match-beginning 0))
294 (unless (looking-at "Hash:[ \t]*\\([a-zA-Z0-9]+\\)")
295 (error "Cannot not find PGP hash"))
296 (setq hash (match-string 1))
297 (unless (re-search-forward "^$" nil t)
298 (error "Cannot not find PGP message"))
300 (delete-region (point-min) (point))
301 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
303 (insert (format "\tmicalg=pgp-%s; protocol=\"application/pgp-signature\"\n"
305 (insert (format "\n--%s\n" boundary))
307 (goto-char (point-max))
308 (unless (re-search-backward "^-----END PGP SIGNATURE-----\r?$" nil t)
309 (error "Cannot find signature part"))
310 (replace-match "-----END PGP MESSAGE-----" t t)
311 (goto-char (match-beginning 0))
312 (unless (re-search-backward "^-----BEGIN PGP SIGNATURE-----\r?$"
314 (error "Cannot find signature part"))
315 (replace-match "-----BEGIN PGP MESSAGE-----" t t)
316 (goto-char (match-beginning 0))
318 (narrow-to-region point (point))
320 (while (re-search-forward "^- -" nil t)
321 (replace-match "-" t t))
322 (goto-char (point-max)))
323 (insert (format "--%s\n" boundary))
324 (insert "Content-Type: application/pgp-signature\n\n")
325 (goto-char (point-max))
326 (insert (format "--%s--\n" boundary))
327 (goto-char (point-max))))
329 (defun mml2015-mailcrypt-encrypt (cont &optional sign)
330 (let ((mc-pgp-always-sign
331 (or mc-pgp-always-sign
333 (eq t (or (message-options-get 'message-sign-encrypt)
335 'message-sign-encrypt
336 (or (y-or-n-p "Sign the message? ")
339 (mm-with-unibyte-current-buffer
341 (or (message-options-get 'message-recipients)
342 (message-options-set 'message-recipients
343 (mc-cleanup-recipient-headers
344 (read-string "Recipients: "))))
346 (message-options-get 'message-sender))))
347 (goto-char (point-min))
348 (unless (looking-at "-----BEGIN PGP MESSAGE-----")
349 (error "Fail to encrypt the message"))
350 (let ((boundary (mml-compute-boundary cont)))
351 (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
353 (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
354 (insert (format "--%s\n" boundary))
355 (insert "Content-Type: application/pgp-encrypted\n\n")
356 (insert "Version: 1\n\n")
357 (insert (format "--%s\n" boundary))
358 (insert "Content-Type: application/octet-stream\n\n")
359 (goto-char (point-max))
360 (insert (format "--%s--\n" boundary))
361 (goto-char (point-max))))
366 (autoload 'gpg-decrypt "gpg")
367 (autoload 'gpg-verify "gpg")
368 (autoload 'gpg-verify-cleartext "gpg")
369 (autoload 'gpg-sign-detached "gpg")
370 (autoload 'gpg-sign-encrypt "gpg")
371 (autoload 'gpg-encrypt "gpg")
372 (autoload 'gpg-passphrase-read "gpg"))
374 (defun mml2015-gpg-passphrase ()
375 (or (message-options-get 'gpg-passphrase)
376 (message-options-set 'gpg-passphrase (gpg-passphrase-read))))
378 (defun mml2015-gpg-decrypt-1 ()
379 (let ((cipher (current-buffer)) plain result)
380 (if (with-temp-buffer
382 (gpg-decrypt cipher (setq plain (current-buffer))
383 mml2015-result-buffer nil)
384 (mm-set-handle-multipart-parameter
385 mm-security-handle 'gnus-details
386 (with-current-buffer mml2015-result-buffer
390 (insert-buffer-substring plain)
391 (goto-char (point-min))
392 (while (search-forward "\r\n" nil t)
393 (replace-match "\n" t t))))
395 ;; Some wrong with the return value, check plain text buffer.
396 (if (> (point-max) (point-min))
400 (defun mml2015-gpg-decrypt (handle ctl)
401 (let ((mml2015-decrypt-function 'mml2015-gpg-decrypt-1))
402 (mml2015-mailcrypt-decrypt handle ctl)))
404 (defun mml2015-gpg-clear-decrypt ()
406 (setq result (mml2015-gpg-decrypt-1))
408 (mm-set-handle-multipart-parameter
409 mm-security-handle 'gnus-info "OK")
410 (mm-set-handle-multipart-parameter
411 mm-security-handle 'gnus-info "Failed"))))
413 (defun mml2015-gpg-pretty-print-fpr (fingerprint)
415 (fpr-length (string-width fingerprint))
418 (setq fingerprint (string-to-list fingerprint))
420 (setq fpr-length (- fpr-length 4))
421 (setq slice (butlast fingerprint fpr-length))
422 (setq fingerprint (nthcdr 4 fingerprint))
423 (setq n-slice (1+ n-slice))
429 (otherwise (concat " " slice))))))
432 (defun mml2015-gpg-extract-signature-details ()
433 (goto-char (point-min))
434 (let* ((expired (re-search-forward
435 "^\\[GNUPG:\\] SIGEXPIRED$"
437 (signer (and (re-search-forward
438 "^\\[GNUPG:\\] GOODSIG \\([0-9A-Za-z]*\\) \\(.*\\)$"
440 (cons (match-string 1) (match-string 2))))
441 (fprint (and (re-search-forward
442 "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) "
445 (trust (and (re-search-forward
446 "^\\[GNUPG:\\] \\(TRUST_.*\\)$"
450 (cdr (assoc trust mml2015-unabbrev-trust-alist))))
451 (cond ((and signer fprint)
453 (unless trust-good-enough-p
454 (concat "\nUntrusted, Fingerprint: "
455 (mml2015-gpg-pretty-print-fpr fprint)))
457 (format "\nWARNING: Signature from expired key (%s)"
460 "^\\(gpg: \\)?Good signature from \"\\(.*\\)\"$" nil t)
463 "From unknown user"))))
465 (defun mml2015-gpg-verify (handle ctl)
467 (let (part message signature info-is-set-p)
468 (unless (setq part (mm-find-raw-part-by-type
469 ctl (or (mm-handle-multipart-ctl-parameter
471 "application/pgp-signature")
473 (mm-set-handle-multipart-parameter
474 mm-security-handle 'gnus-info "Corrupted")
475 (throw 'error handle))
477 (setq message (current-buffer))
479 ;; Convert <LF> to <CR><LF> in verify mode. Sign and
480 ;; clearsign use --textmode. The conversion is not necessary.
481 ;; In clearverify, the conversion is not necessary either.
482 (goto-char (point-min))
485 (unless (eq (char-before) ?\r)
490 (setq signature (current-buffer))
491 (unless (setq part (mm-find-part-by-type
492 (cdr handle) "application/pgp-signature" nil t))
493 (mm-set-handle-multipart-parameter
494 mm-security-handle 'gnus-info "Corrupted")
495 (throw 'error handle))
496 (mm-insert-part part)
497 (unless (condition-case err
499 (gpg-verify message signature mml2015-result-buffer)
500 (mm-set-handle-multipart-parameter
501 mm-security-handle 'gnus-details
502 (with-current-buffer mml2015-result-buffer
505 (mm-set-handle-multipart-parameter
506 mm-security-handle 'gnus-details (mml2015-format-error err))
507 (mm-set-handle-multipart-parameter
508 mm-security-handle 'gnus-info "Error.")
509 (setq info-is-set-p t)
512 (mm-set-handle-multipart-parameter
513 mm-security-handle 'gnus-details "Quit.")
514 (mm-set-handle-multipart-parameter
515 mm-security-handle 'gnus-info "Quit.")
516 (setq info-is-set-p t)
518 (unless info-is-set-p
519 (mm-set-handle-multipart-parameter
520 mm-security-handle 'gnus-info "Failed"))
521 (throw 'error handle)))
522 (mm-set-handle-multipart-parameter
523 mm-security-handle 'gnus-info
524 (with-current-buffer mml2015-result-buffer
525 (mml2015-gpg-extract-signature-details))))
528 (defun mml2015-gpg-clear-verify ()
529 (if (condition-case err
531 (gpg-verify-cleartext (current-buffer) mml2015-result-buffer)
532 (mm-set-handle-multipart-parameter
533 mm-security-handle 'gnus-details
534 (with-current-buffer mml2015-result-buffer
537 (mm-set-handle-multipart-parameter
538 mm-security-handle 'gnus-details (mml2015-format-error err))
541 (mm-set-handle-multipart-parameter
542 mm-security-handle 'gnus-details "Quit.")
544 (mm-set-handle-multipart-parameter
545 mm-security-handle 'gnus-info
546 (with-current-buffer mml2015-result-buffer
547 (mml2015-gpg-extract-signature-details)))
548 (mm-set-handle-multipart-parameter
549 mm-security-handle 'gnus-info "Failed")))
551 (defun mml2015-gpg-sign (cont)
552 (let ((boundary (mml-compute-boundary cont))
553 (text (current-buffer)) signature)
554 (goto-char (point-max))
558 (unless (gpg-sign-detached text (setq signature (current-buffer))
559 mml2015-result-buffer
561 (message-options-get 'message-sender)
562 t t) ; armor & textmode
563 (unless (> (point-max) (point-min))
564 (pop-to-buffer mml2015-result-buffer)
565 (error "Sign error")))
566 (goto-char (point-min))
567 (while (re-search-forward "\r+$" nil t)
568 (replace-match "" t t))
570 (goto-char (point-min))
571 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
573 ;;; FIXME: what is the micalg?
574 (insert "\tmicalg=pgp-sha1; protocol=\"application/pgp-signature\"\n")
575 (insert (format "\n--%s\n" boundary))
576 (goto-char (point-max))
577 (insert (format "\n--%s\n" boundary))
578 (insert "Content-Type: application/pgp-signature\n\n")
579 (insert-buffer-substring signature)
580 (goto-char (point-max))
581 (insert (format "--%s--\n" boundary))
582 (goto-char (point-max)))))
584 (defun mml2015-gpg-encrypt (cont &optional sign)
585 (let ((boundary (mml-compute-boundary cont))
586 (text (current-buffer))
588 (mm-with-unibyte-current-buffer
590 ;; set up a function to call the correct gpg encrypt routine
591 ;; with the right arguments. (FIXME: this should be done
593 (flet ((gpg-encrypt-func
594 (sign plaintext ciphertext result recipients &optional
595 passphrase sign-with-key armor textmode)
598 plaintext ciphertext result recipients passphrase
599 sign-with-key armor textmode)
601 plaintext ciphertext result recipients passphrase
603 (unless (gpg-encrypt-func
604 sign ; passed in when using signencrypt
605 text (setq cipher (current-buffer))
606 mml2015-result-buffer
609 (message-options-get 'message-recipients)
610 (message-options-set 'message-recipients
611 (read-string "Recipients: ")))
614 (message-options-get 'message-sender)
615 t t) ; armor & textmode
616 (unless (> (point-max) (point-min))
617 (pop-to-buffer mml2015-result-buffer)
618 (error "Encrypt error"))))
619 (goto-char (point-min))
620 (while (re-search-forward "\r+$" nil t)
621 (replace-match "" t t))
623 (delete-region (point-min) (point-max))
624 (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
626 (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
627 (insert (format "--%s\n" boundary))
628 (insert "Content-Type: application/pgp-encrypted\n\n")
629 (insert "Version: 1\n\n")
630 (insert (format "--%s\n" boundary))
631 (insert "Content-Type: application/octet-stream\n\n")
632 (insert-buffer-substring cipher)
633 (goto-char (point-max))
634 (insert (format "--%s--\n" boundary))
635 (goto-char (point-max))))))
640 (defvar pgg-default-user-id)
641 (defvar pgg-errors-buffer)
642 (defvar pgg-output-buffer))
645 (autoload 'pgg-decrypt-region "pgg")
646 (autoload 'pgg-verify-region "pgg")
647 (autoload 'pgg-sign-region "pgg")
648 (autoload 'pgg-encrypt-region "pgg")
649 (autoload 'pgg-parse-armor "pgg-parse"))
651 (defun mml2015-pgg-decrypt (handle ctl)
653 (let ((pgg-errors-buffer mml2015-result-buffer)
654 child handles result decrypt-status)
655 (unless (setq child (mm-find-part-by-type
657 "application/octet-stream" nil t))
658 (mm-set-handle-multipart-parameter
659 mm-security-handle 'gnus-info "Corrupted")
660 (throw 'error handle))
662 (mm-insert-part child)
663 (if (condition-case err
665 (pgg-decrypt-region (point-min) (point-max))
667 (with-current-buffer mml2015-result-buffer
669 (mm-set-handle-multipart-parameter
670 mm-security-handle 'gnus-details
673 (mm-set-handle-multipart-parameter
674 mm-security-handle 'gnus-details (mml2015-format-error err))
677 (mm-set-handle-multipart-parameter
678 mm-security-handle 'gnus-details "Quit.")
680 (with-current-buffer pgg-output-buffer
681 (goto-char (point-min))
682 (while (search-forward "\r\n" nil t)
683 (replace-match "\n" t t))
684 (setq handles (mm-dissect-buffer t))
685 (mm-destroy-parts handle)
686 (mm-set-handle-multipart-parameter
687 mm-security-handle 'gnus-info "OK")
688 (mm-set-handle-multipart-parameter
689 mm-security-handle 'gnus-details
690 (concat decrypt-status
691 (when (stringp (car handles))
692 "\n" (mm-handle-multipart-ctl-parameter
693 handles 'gnus-details))))
694 (if (listp (car handles))
697 (mm-set-handle-multipart-parameter
698 mm-security-handle 'gnus-info "Failed")
699 (throw 'error handle))))))
701 (defun mml2015-pgg-clear-decrypt ()
702 (let ((pgg-errors-buffer mml2015-result-buffer))
704 (pgg-decrypt-region (point-min) (point-max))
705 (mm-set-handle-multipart-parameter
706 mm-security-handle 'gnus-details
707 (with-current-buffer mml2015-result-buffer
711 (insert-buffer-substring pgg-output-buffer)
712 (goto-char (point-min))
713 (while (search-forward "\r\n" nil t)
714 (replace-match "\n" t t))
715 (mm-set-handle-multipart-parameter
716 mm-security-handle 'gnus-info "OK"))
717 (mm-set-handle-multipart-parameter
718 mm-security-handle 'gnus-info "Failed"))))
720 (defun mml2015-pgg-verify (handle ctl)
721 (let ((pgg-errors-buffer mml2015-result-buffer)
722 signature-file part signature)
723 (if (or (null (setq part (mm-find-raw-part-by-type
724 ctl (or (mm-handle-multipart-ctl-parameter
726 "application/pgp-signature")
728 (null (setq signature (mm-find-part-by-type
729 (cdr handle) "application/pgp-signature" nil t))))
731 (mm-set-handle-multipart-parameter
732 mm-security-handle 'gnus-info "Corrupted")
736 ;; Convert <LF> to <CR><LF> in verify mode. Sign and
737 ;; clearsign use --textmode. The conversion is not necessary.
738 ;; In clearverify, the conversion is not necessary either.
739 (goto-char (point-min))
742 (unless (eq (char-before) ?\r)
746 (with-temp-file (setq signature-file (mm-make-temp-file "pgg"))
747 (mm-insert-part signature))
748 (if (condition-case err
750 (pgg-verify-region (point-min) (point-max)
752 (goto-char (point-min))
753 (while (search-forward "\r\n" nil t)
754 (replace-match "\n" t t))
755 (mm-set-handle-multipart-parameter
756 mm-security-handle 'gnus-details
757 (concat (with-current-buffer pgg-output-buffer
759 (with-current-buffer pgg-errors-buffer
762 (mm-set-handle-multipart-parameter
763 mm-security-handle 'gnus-details (mml2015-format-error err))
766 (mm-set-handle-multipart-parameter
767 mm-security-handle 'gnus-details "Quit.")
770 (delete-file signature-file)
771 (mm-set-handle-multipart-parameter
772 mm-security-handle 'gnus-info
773 (with-current-buffer pgg-errors-buffer
774 (mml2015-gpg-extract-signature-details))))
775 (delete-file signature-file)
776 (mm-set-handle-multipart-parameter
777 mm-security-handle 'gnus-info "Failed")))))
780 (defun mml2015-pgg-clear-verify ()
781 (let ((pgg-errors-buffer mml2015-result-buffer)
782 (text (buffer-string))
783 (coding-system buffer-file-coding-system))
784 (if (condition-case err
786 (mm-with-unibyte-buffer
787 (insert (encode-coding-string text coding-system))
788 (pgg-verify-region (point-min) (point-max) nil t))
789 (goto-char (point-min))
790 (while (search-forward "\r\n" nil t)
791 (replace-match "\n" t t))
792 (mm-set-handle-multipart-parameter
793 mm-security-handle 'gnus-details
794 (concat (with-current-buffer pgg-output-buffer
796 (with-current-buffer pgg-errors-buffer
799 (mm-set-handle-multipart-parameter
800 mm-security-handle 'gnus-details (mml2015-format-error err))
803 (mm-set-handle-multipart-parameter
804 mm-security-handle 'gnus-details "Quit.")
806 (mm-set-handle-multipart-parameter
807 mm-security-handle 'gnus-info
808 (with-current-buffer pgg-errors-buffer
809 (mml2015-gpg-extract-signature-details)))
810 (mm-set-handle-multipart-parameter
811 mm-security-handle 'gnus-info "Failed"))))
813 (defun mml2015-pgg-sign (cont)
814 (let ((pgg-errors-buffer mml2015-result-buffer)
815 (boundary (mml-compute-boundary cont))
816 (pgg-default-user-id (or (message-options-get 'mml-sender)
817 pgg-default-user-id))
819 (unless (pgg-sign-region (point-min) (point-max))
820 (pop-to-buffer mml2015-result-buffer)
821 (error "Sign error"))
822 (goto-char (point-min))
823 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
825 (if (setq entry (assq 2 (pgg-parse-armor
826 (with-current-buffer pgg-output-buffer
828 (setq entry (assq 'hash-algorithm (cdr entry))))
829 (insert (format "\tmicalg=%s; "
831 (downcase (format "pgp-%s" (cdr entry)))
833 (insert "protocol=\"application/pgp-signature\"\n")
834 (insert (format "\n--%s\n" boundary))
835 (goto-char (point-max))
836 (insert (format "\n--%s\n" boundary))
837 (insert "Content-Type: application/pgp-signature\n\n")
838 (insert-buffer-substring pgg-output-buffer)
839 (goto-char (point-max))
840 (insert (format "--%s--\n" boundary))
841 (goto-char (point-max))))
843 (defun mml2015-pgg-encrypt (cont &optional sign)
844 (let ((pgg-errors-buffer mml2015-result-buffer)
845 (boundary (mml-compute-boundary cont)))
846 (unless (pgg-encrypt-region (point-min) (point-max)
849 (message-options-get 'message-recipients)
850 (message-options-set 'message-recipients
851 (read-string "Recipients: ")))
854 (pop-to-buffer mml2015-result-buffer)
855 (error "Encrypt error"))
856 (delete-region (point-min) (point-max))
857 (goto-char (point-min))
858 (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
860 (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
861 (insert (format "--%s\n" boundary))
862 (insert "Content-Type: application/pgp-encrypted\n\n")
863 (insert "Version: 1\n\n")
864 (insert (format "--%s\n" boundary))
865 (insert "Content-Type: application/octet-stream\n\n")
866 (insert-buffer-substring pgg-output-buffer)
867 (goto-char (point-max))
868 (insert (format "--%s--\n" boundary))
869 (goto-char (point-max))))
873 (defun mml2015-clean-buffer ()
874 (if (gnus-buffer-live-p mml2015-result-buffer)
875 (with-current-buffer mml2015-result-buffer
878 (setq mml2015-result-buffer
879 (gnus-get-buffer-create " *MML2015 Result*"))
882 (defsubst mml2015-clear-decrypt-function ()
883 (nth 6 (assq mml2015-use mml2015-function-alist)))
885 (defsubst mml2015-clear-verify-function ()
886 (nth 5 (assq mml2015-use mml2015-function-alist)))
889 (defun mml2015-decrypt (handle ctl)
890 (mml2015-clean-buffer)
891 (let ((func (nth 4 (assq mml2015-use mml2015-function-alist))))
893 (funcall func handle ctl)
897 (defun mml2015-decrypt-test (handle ctl)
901 (defun mml2015-verify (handle ctl)
902 (mml2015-clean-buffer)
903 (let ((func (nth 3 (assq mml2015-use mml2015-function-alist))))
905 (funcall func handle ctl)
909 (defun mml2015-verify-test (handle ctl)
913 (defun mml2015-encrypt (cont &optional sign)
914 (mml2015-clean-buffer)
915 (let ((func (nth 2 (assq mml2015-use mml2015-function-alist))))
917 (funcall func cont sign)
918 (error "Cannot find encrypt function"))))
921 (defun mml2015-sign (cont)
922 (mml2015-clean-buffer)
923 (let ((func (nth 1 (assq mml2015-use mml2015-function-alist))))
926 (error "Cannot find sign function"))))
929 (defun mml2015-self-encrypt ()
930 (mml2015-encrypt nil))
934 ;;; mml2015.el ends here