1 ;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP)
3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
4 ;; 2005 Free Software Foundation, Inc.
6 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
7 ;; Keywords: PGP MIME MML
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published
13 ;; by the Free Software Foundation; either version 2, or (at your
14 ;; option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 ;; Boston, MA 02110-1301, USA.
28 ;; RFC 2015 is updated by RFC 3156, this file should be compatible
33 (eval-when-compile (require 'cl))
38 (defvar mml2015-use (or
41 ;; Avoid the "Recursive load suspected" error
43 (let ((recursive-load-depth-limit 100))
45 (and (fboundp 'pgg-sign-region)
50 (and (fboundp 'gpg-sign-detached)
54 (and (fboundp 'mc-encrypt-generic)
55 (fboundp 'mc-sign-generic)
56 (fboundp 'mc-cleanup-recipient-headers)
58 "The package used for PGP/MIME.
59 Valid packages include `pgg', `gpg' and `mailcrypt'.")
61 ;; Something is not RFC2015.
62 (defvar mml2015-function-alist
63 '((mailcrypt mml2015-mailcrypt-sign
64 mml2015-mailcrypt-encrypt
65 mml2015-mailcrypt-verify
66 mml2015-mailcrypt-decrypt
67 mml2015-mailcrypt-clear-verify
68 mml2015-mailcrypt-clear-decrypt)
73 mml2015-gpg-clear-verify
74 mml2015-gpg-clear-decrypt)
79 mml2015-pgg-clear-verify
80 mml2015-pgg-clear-decrypt))
81 "Alist of PGP/MIME functions.")
83 (defvar mml2015-result-buffer nil)
85 (defcustom mml2015-unabbrev-trust-alist
86 '(("TRUST_UNDEFINED" . nil)
88 ("TRUST_MARGINAL" . t)
90 ("TRUST_ULTIMATE" . t))
91 "Map GnuPG trust output values to a boolean saying if you trust the key."
94 :type '(repeat (cons (regexp :tag "GnuPG output regexp")
95 (boolean :tag "Trust key"))))
100 (autoload 'mailcrypt-decrypt "mailcrypt")
101 (autoload 'mailcrypt-verify "mailcrypt")
102 (autoload 'mc-pgp-always-sign "mailcrypt")
103 (autoload 'mc-encrypt-generic "mc-toplev")
104 (autoload 'mc-cleanup-recipient-headers "mc-toplev")
105 (autoload 'mc-sign-generic "mc-toplev"))
108 (defvar mc-default-scheme)
111 (defvar mml2015-decrypt-function 'mailcrypt-decrypt)
112 (defvar mml2015-verify-function 'mailcrypt-verify)
114 (defun mml2015-format-error (err)
115 (if (stringp (cadr err))
117 (format "%S" (cdr err))))
119 (defun mml2015-mailcrypt-decrypt (handle ctl)
121 (let (child handles result)
122 (unless (setq child (mm-find-part-by-type
124 "application/octet-stream" nil t))
125 (mm-set-handle-multipart-parameter
126 mm-security-handle 'gnus-info "Corrupted")
127 (throw 'error handle))
129 (mm-insert-part child)
132 (funcall mml2015-decrypt-function)
134 (mm-set-handle-multipart-parameter
135 mm-security-handle 'gnus-details (mml2015-format-error err))
138 (mm-set-handle-multipart-parameter
139 mm-security-handle 'gnus-details "Quit.")
142 (mm-set-handle-multipart-parameter
143 mm-security-handle 'gnus-info "Failed")
144 (throw 'error handle))
145 (setq handles (mm-dissect-buffer t)))
146 (mm-destroy-parts handle)
147 (mm-set-handle-multipart-parameter
148 mm-security-handle 'gnus-info
150 (let ((sig (with-current-buffer mml2015-result-buffer
151 (mml2015-gpg-extract-signature-details))))
152 (concat ", Signer: " sig))))
153 (if (listp (car handles))
157 (defun mml2015-mailcrypt-clear-decrypt ()
161 (funcall mml2015-decrypt-function)
163 (mm-set-handle-multipart-parameter
164 mm-security-handle 'gnus-details (mml2015-format-error err))
167 (mm-set-handle-multipart-parameter
168 mm-security-handle 'gnus-details "Quit.")
171 (mm-set-handle-multipart-parameter
172 mm-security-handle 'gnus-info "OK")
173 (mm-set-handle-multipart-parameter
174 mm-security-handle 'gnus-info "Failed"))))
176 (defun mml2015-fix-micalg (alg)
178 ;; Mutt/1.2.5i has seen sending micalg=php-sha1
179 (upcase (if (string-match "^p[gh]p-" alg)
180 (substring alg (match-end 0))
183 (defun mml2015-mailcrypt-verify (handle ctl)
186 (unless (setq part (mm-find-raw-part-by-type
187 ctl (or (mm-handle-multipart-ctl-parameter
189 "application/pgp-signature")
191 (mm-set-handle-multipart-parameter
192 mm-security-handle 'gnus-info "Corrupted")
193 (throw 'error handle))
195 (insert "-----BEGIN PGP SIGNED MESSAGE-----\n")
196 (insert (format "Hash: %s\n\n"
197 (or (mml2015-fix-micalg
198 (mm-handle-multipart-ctl-parameter
202 (narrow-to-region (point) (point))
204 (goto-char (point-min))
206 (if (looking-at "^-")
209 (unless (setq part (mm-find-part-by-type
210 (cdr handle) "application/pgp-signature" nil t))
211 (mm-set-handle-multipart-parameter
212 mm-security-handle 'gnus-info "Corrupted")
213 (throw 'error handle))
215 (narrow-to-region (point) (point))
216 (mm-insert-part part)
217 (goto-char (point-min))
218 (if (re-search-forward "^-----BEGIN PGP [^-]+-----\r?$" nil t)
219 (replace-match "-----BEGIN PGP SIGNATURE-----" t t))
220 (if (re-search-forward "^-----END PGP [^-]+-----\r?$" nil t)
221 (replace-match "-----END PGP SIGNATURE-----" t t)))
222 (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
223 (unless (condition-case err
225 (funcall mml2015-verify-function)
226 (if (get-buffer " *mailcrypt stderr temp")
227 (mm-set-handle-multipart-parameter
228 mm-security-handle 'gnus-details
229 (with-current-buffer " *mailcrypt stderr temp"
231 (if (get-buffer " *mailcrypt stdout temp")
232 (kill-buffer " *mailcrypt stdout temp"))
233 (if (get-buffer " *mailcrypt stderr temp")
234 (kill-buffer " *mailcrypt stderr temp"))
235 (if (get-buffer " *mailcrypt status temp")
236 (kill-buffer " *mailcrypt status temp"))
237 (if (get-buffer mc-gpg-debug-buffer)
238 (kill-buffer mc-gpg-debug-buffer)))
240 (mm-set-handle-multipart-parameter
241 mm-security-handle 'gnus-details (mml2015-format-error err))
244 (mm-set-handle-multipart-parameter
245 mm-security-handle 'gnus-details "Quit.")
247 (mm-set-handle-multipart-parameter
248 mm-security-handle 'gnus-info "Failed")
249 (throw 'error handle))))
250 (mm-set-handle-multipart-parameter
251 mm-security-handle 'gnus-info "OK")
254 (defun mml2015-mailcrypt-clear-verify ()
255 (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
256 (if (condition-case err
258 (funcall mml2015-verify-function)
259 (if (get-buffer " *mailcrypt stderr temp")
260 (mm-set-handle-multipart-parameter
261 mm-security-handle 'gnus-details
262 (with-current-buffer " *mailcrypt stderr temp"
264 (if (get-buffer " *mailcrypt stdout temp")
265 (kill-buffer " *mailcrypt stdout temp"))
266 (if (get-buffer " *mailcrypt stderr temp")
267 (kill-buffer " *mailcrypt stderr temp"))
268 (if (get-buffer " *mailcrypt status temp")
269 (kill-buffer " *mailcrypt status temp"))
270 (if (get-buffer mc-gpg-debug-buffer)
271 (kill-buffer mc-gpg-debug-buffer)))
273 (mm-set-handle-multipart-parameter
274 mm-security-handle 'gnus-details (mml2015-format-error err))
277 (mm-set-handle-multipart-parameter
278 mm-security-handle 'gnus-details "Quit.")
280 (mm-set-handle-multipart-parameter
281 mm-security-handle 'gnus-info "OK")
282 (mm-set-handle-multipart-parameter
283 mm-security-handle 'gnus-info "Failed"))))
285 (defun mml2015-mailcrypt-sign (cont)
286 (mc-sign-generic (message-options-get 'message-sender)
288 (let ((boundary (mml-compute-boundary cont))
290 (goto-char (point-min))
291 (unless (re-search-forward "^-----BEGIN PGP SIGNED MESSAGE-----\r?$" nil t)
292 (error "Cannot find signed begin line"))
293 (goto-char (match-beginning 0))
295 (unless (looking-at "Hash:[ \t]*\\([a-zA-Z0-9]+\\)")
296 (error "Cannot not find PGP hash"))
297 (setq hash (match-string 1))
298 (unless (re-search-forward "^$" nil t)
299 (error "Cannot not find PGP message"))
301 (delete-region (point-min) (point))
302 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
304 (insert (format "\tmicalg=pgp-%s; protocol=\"application/pgp-signature\"\n"
306 (insert (format "\n--%s\n" boundary))
308 (goto-char (point-max))
309 (unless (re-search-backward "^-----END PGP SIGNATURE-----\r?$" nil t)
310 (error "Cannot find signature part"))
311 (replace-match "-----END PGP MESSAGE-----" t t)
312 (goto-char (match-beginning 0))
313 (unless (re-search-backward "^-----BEGIN PGP SIGNATURE-----\r?$"
315 (error "Cannot find signature part"))
316 (replace-match "-----BEGIN PGP MESSAGE-----" t t)
317 (goto-char (match-beginning 0))
319 (narrow-to-region point (point))
321 (while (re-search-forward "^- -" nil t)
322 (replace-match "-" t t))
323 (goto-char (point-max)))
324 (insert (format "--%s\n" boundary))
325 (insert "Content-Type: application/pgp-signature\n\n")
326 (goto-char (point-max))
327 (insert (format "--%s--\n" boundary))
328 (goto-char (point-max))))
330 (defun mml2015-mailcrypt-encrypt (cont &optional sign)
331 (let ((mc-pgp-always-sign
332 (or mc-pgp-always-sign
334 (eq t (or (message-options-get 'message-sign-encrypt)
336 'message-sign-encrypt
337 (or (y-or-n-p "Sign the message? ")
340 (mm-with-unibyte-current-buffer
342 (or (message-options-get 'message-recipients)
343 (message-options-set 'message-recipients
344 (mc-cleanup-recipient-headers
345 (read-string "Recipients: "))))
347 (message-options-get 'message-sender))))
348 (goto-char (point-min))
349 (unless (looking-at "-----BEGIN PGP MESSAGE-----")
350 (error "Fail to encrypt the message"))
351 (let ((boundary (mml-compute-boundary cont)))
352 (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
354 (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
355 (insert (format "--%s\n" boundary))
356 (insert "Content-Type: application/pgp-encrypted\n\n")
357 (insert "Version: 1\n\n")
358 (insert (format "--%s\n" boundary))
359 (insert "Content-Type: application/octet-stream\n\n")
360 (goto-char (point-max))
361 (insert (format "--%s--\n" boundary))
362 (goto-char (point-max))))
367 (autoload 'gpg-decrypt "gpg")
368 (autoload 'gpg-verify "gpg")
369 (autoload 'gpg-verify-cleartext "gpg")
370 (autoload 'gpg-sign-detached "gpg")
371 (autoload 'gpg-sign-encrypt "gpg")
372 (autoload 'gpg-encrypt "gpg")
373 (autoload 'gpg-passphrase-read "gpg"))
375 (defun mml2015-gpg-passphrase ()
376 (or (message-options-get 'gpg-passphrase)
377 (message-options-set 'gpg-passphrase (gpg-passphrase-read))))
379 (defun mml2015-gpg-decrypt-1 ()
380 (let ((cipher (current-buffer)) plain result)
381 (if (with-temp-buffer
383 (gpg-decrypt cipher (setq plain (current-buffer))
384 mml2015-result-buffer nil)
385 (mm-set-handle-multipart-parameter
386 mm-security-handle 'gnus-details
387 (with-current-buffer mml2015-result-buffer
391 (insert-buffer-substring plain)
392 (goto-char (point-min))
393 (while (search-forward "\r\n" nil t)
394 (replace-match "\n" t t))))
396 ;; Some wrong with the return value, check plain text buffer.
397 (if (> (point-max) (point-min))
401 (defun mml2015-gpg-decrypt (handle ctl)
402 (let ((mml2015-decrypt-function 'mml2015-gpg-decrypt-1))
403 (mml2015-mailcrypt-decrypt handle ctl)))
405 (defun mml2015-gpg-clear-decrypt ()
407 (setq result (mml2015-gpg-decrypt-1))
409 (mm-set-handle-multipart-parameter
410 mm-security-handle 'gnus-info "OK")
411 (mm-set-handle-multipart-parameter
412 mm-security-handle 'gnus-info "Failed"))))
414 (defun mml2015-gpg-pretty-print-fpr (fingerprint)
416 (fpr-length (string-width fingerprint))
419 (setq fingerprint (string-to-list fingerprint))
421 (setq fpr-length (- fpr-length 4))
422 (setq slice (butlast fingerprint fpr-length))
423 (setq fingerprint (nthcdr 4 fingerprint))
424 (setq n-slice (1+ n-slice))
430 (otherwise (concat " " slice))))))
433 (defun mml2015-gpg-extract-signature-details ()
434 (goto-char (point-min))
435 (let* ((expired (re-search-forward
436 "^\\[GNUPG:\\] SIGEXPIRED$"
438 (signer (and (re-search-forward
439 "^\\[GNUPG:\\] GOODSIG \\([0-9A-Za-z]*\\) \\(.*\\)$"
441 (cons (match-string 1) (match-string 2))))
442 (fprint (and (re-search-forward
443 "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) "
446 (trust (and (re-search-forward
447 "^\\[GNUPG:\\] \\(TRUST_.*\\)$"
451 (cdr (assoc trust mml2015-unabbrev-trust-alist))))
452 (cond ((and signer fprint)
454 (unless trust-good-enough-p
455 (concat "\nUntrusted, Fingerprint: "
456 (mml2015-gpg-pretty-print-fpr fprint)))
458 (format "\nWARNING: Signature from expired key (%s)"
461 "^\\(gpg: \\)?Good signature from \"\\(.*\\)\"$" nil t)
464 "From unknown user"))))
466 (defun mml2015-gpg-verify (handle ctl)
468 (let (part message signature info-is-set-p)
469 (unless (setq part (mm-find-raw-part-by-type
470 ctl (or (mm-handle-multipart-ctl-parameter
472 "application/pgp-signature")
474 (mm-set-handle-multipart-parameter
475 mm-security-handle 'gnus-info "Corrupted")
476 (throw 'error handle))
478 (setq message (current-buffer))
480 ;; Convert <LF> to <CR><LF> in verify mode. Sign and
481 ;; clearsign use --textmode. The conversion is not necessary.
482 ;; In clearverify, the conversion is not necessary either.
483 (goto-char (point-min))
486 (unless (eq (char-before) ?\r)
491 (setq signature (current-buffer))
492 (unless (setq part (mm-find-part-by-type
493 (cdr handle) "application/pgp-signature" nil t))
494 (mm-set-handle-multipart-parameter
495 mm-security-handle 'gnus-info "Corrupted")
496 (throw 'error handle))
497 (mm-insert-part part)
498 (unless (condition-case err
500 (gpg-verify message signature mml2015-result-buffer)
501 (mm-set-handle-multipart-parameter
502 mm-security-handle 'gnus-details
503 (with-current-buffer mml2015-result-buffer
506 (mm-set-handle-multipart-parameter
507 mm-security-handle 'gnus-details (mml2015-format-error err))
508 (mm-set-handle-multipart-parameter
509 mm-security-handle 'gnus-info "Error.")
510 (setq info-is-set-p t)
513 (mm-set-handle-multipart-parameter
514 mm-security-handle 'gnus-details "Quit.")
515 (mm-set-handle-multipart-parameter
516 mm-security-handle 'gnus-info "Quit.")
517 (setq info-is-set-p t)
519 (unless info-is-set-p
520 (mm-set-handle-multipart-parameter
521 mm-security-handle 'gnus-info "Failed"))
522 (throw 'error handle)))
523 (mm-set-handle-multipart-parameter
524 mm-security-handle 'gnus-info
525 (with-current-buffer mml2015-result-buffer
526 (mml2015-gpg-extract-signature-details))))
529 (defun mml2015-gpg-clear-verify ()
530 (if (condition-case err
532 (gpg-verify-cleartext (current-buffer) mml2015-result-buffer)
533 (mm-set-handle-multipart-parameter
534 mm-security-handle 'gnus-details
535 (with-current-buffer mml2015-result-buffer
538 (mm-set-handle-multipart-parameter
539 mm-security-handle 'gnus-details (mml2015-format-error err))
542 (mm-set-handle-multipart-parameter
543 mm-security-handle 'gnus-details "Quit.")
545 (mm-set-handle-multipart-parameter
546 mm-security-handle 'gnus-info
547 (with-current-buffer mml2015-result-buffer
548 (mml2015-gpg-extract-signature-details)))
549 (mm-set-handle-multipart-parameter
550 mm-security-handle 'gnus-info "Failed")))
552 (defun mml2015-gpg-sign (cont)
553 (let ((boundary (mml-compute-boundary cont))
554 (text (current-buffer)) signature)
555 (goto-char (point-max))
559 (unless (gpg-sign-detached text (setq signature (current-buffer))
560 mml2015-result-buffer
562 (message-options-get 'message-sender)
563 t t) ; armor & textmode
564 (unless (> (point-max) (point-min))
565 (pop-to-buffer mml2015-result-buffer)
566 (error "Sign error")))
567 (goto-char (point-min))
568 (while (re-search-forward "\r+$" nil t)
569 (replace-match "" t t))
571 (goto-char (point-min))
572 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
574 ;;; FIXME: what is the micalg?
575 (insert "\tmicalg=pgp-sha1; protocol=\"application/pgp-signature\"\n")
576 (insert (format "\n--%s\n" boundary))
577 (goto-char (point-max))
578 (insert (format "\n--%s\n" boundary))
579 (insert "Content-Type: application/pgp-signature\n\n")
580 (insert-buffer-substring signature)
581 (goto-char (point-max))
582 (insert (format "--%s--\n" boundary))
583 (goto-char (point-max)))))
585 (defun mml2015-gpg-encrypt (cont &optional sign)
586 (let ((boundary (mml-compute-boundary cont))
587 (text (current-buffer))
589 (mm-with-unibyte-current-buffer
591 ;; set up a function to call the correct gpg encrypt routine
592 ;; with the right arguments. (FIXME: this should be done
594 (flet ((gpg-encrypt-func
595 (sign plaintext ciphertext result recipients &optional
596 passphrase sign-with-key armor textmode)
599 plaintext ciphertext result recipients passphrase
600 sign-with-key armor textmode)
602 plaintext ciphertext result recipients passphrase
604 (unless (gpg-encrypt-func
605 sign ; passed in when using signencrypt
606 text (setq cipher (current-buffer))
607 mml2015-result-buffer
610 (message-options-get 'message-recipients)
611 (message-options-set 'message-recipients
612 (read-string "Recipients: ")))
615 (message-options-get 'message-sender)
616 t t) ; armor & textmode
617 (unless (> (point-max) (point-min))
618 (pop-to-buffer mml2015-result-buffer)
619 (error "Encrypt error"))))
620 (goto-char (point-min))
621 (while (re-search-forward "\r+$" nil t)
622 (replace-match "" t t))
624 (delete-region (point-min) (point-max))
625 (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
627 (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
628 (insert (format "--%s\n" boundary))
629 (insert "Content-Type: application/pgp-encrypted\n\n")
630 (insert "Version: 1\n\n")
631 (insert (format "--%s\n" boundary))
632 (insert "Content-Type: application/octet-stream\n\n")
633 (insert-buffer-substring cipher)
634 (goto-char (point-max))
635 (insert (format "--%s--\n" boundary))
636 (goto-char (point-max))))))
641 (defvar pgg-default-user-id)
642 (defvar pgg-errors-buffer)
643 (defvar pgg-output-buffer))
646 (autoload 'pgg-decrypt-region "pgg")
647 (autoload 'pgg-verify-region "pgg")
648 (autoload 'pgg-sign-region "pgg")
649 (autoload 'pgg-encrypt-region "pgg")
650 (autoload 'pgg-parse-armor "pgg-parse"))
652 (defun mml2015-pgg-decrypt (handle ctl)
654 (let ((pgg-errors-buffer mml2015-result-buffer)
655 child handles result decrypt-status)
656 (unless (setq child (mm-find-part-by-type
658 "application/octet-stream" nil t))
659 (mm-set-handle-multipart-parameter
660 mm-security-handle 'gnus-info "Corrupted")
661 (throw 'error handle))
663 (mm-insert-part child)
664 (if (condition-case err
666 (pgg-decrypt-region (point-min) (point-max))
668 (with-current-buffer mml2015-result-buffer
670 (mm-set-handle-multipart-parameter
671 mm-security-handle 'gnus-details
674 (mm-set-handle-multipart-parameter
675 mm-security-handle 'gnus-details (mml2015-format-error err))
678 (mm-set-handle-multipart-parameter
679 mm-security-handle 'gnus-details "Quit.")
681 (with-current-buffer pgg-output-buffer
682 (goto-char (point-min))
683 (while (search-forward "\r\n" nil t)
684 (replace-match "\n" t t))
685 (setq handles (mm-dissect-buffer t))
686 (mm-destroy-parts handle)
687 (mm-set-handle-multipart-parameter
688 mm-security-handle 'gnus-info "OK")
689 (mm-set-handle-multipart-parameter
690 mm-security-handle 'gnus-details
691 (concat decrypt-status
692 (when (stringp (car handles))
693 "\n" (mm-handle-multipart-ctl-parameter
694 handles 'gnus-details))))
695 (if (listp (car handles))
698 (mm-set-handle-multipart-parameter
699 mm-security-handle 'gnus-info "Failed")
700 (throw 'error handle))))))
702 (defun mml2015-pgg-clear-decrypt ()
703 (let ((pgg-errors-buffer mml2015-result-buffer))
705 (pgg-decrypt-region (point-min) (point-max))
706 (mm-set-handle-multipart-parameter
707 mm-security-handle 'gnus-details
708 (with-current-buffer mml2015-result-buffer
712 (insert-buffer-substring pgg-output-buffer)
713 (goto-char (point-min))
714 (while (search-forward "\r\n" nil t)
715 (replace-match "\n" t t))
716 (mm-set-handle-multipart-parameter
717 mm-security-handle 'gnus-info "OK"))
718 (mm-set-handle-multipart-parameter
719 mm-security-handle 'gnus-info "Failed"))))
721 (defun mml2015-pgg-verify (handle ctl)
722 (let ((pgg-errors-buffer mml2015-result-buffer)
723 signature-file part signature)
724 (if (or (null (setq part (mm-find-raw-part-by-type
725 ctl (or (mm-handle-multipart-ctl-parameter
727 "application/pgp-signature")
729 (null (setq signature (mm-find-part-by-type
730 (cdr handle) "application/pgp-signature" nil t))))
732 (mm-set-handle-multipart-parameter
733 mm-security-handle 'gnus-info "Corrupted")
737 ;; Convert <LF> to <CR><LF> in verify mode. Sign and
738 ;; clearsign use --textmode. The conversion is not necessary.
739 ;; In clearverify, the conversion is not necessary either.
740 (goto-char (point-min))
743 (unless (eq (char-before) ?\r)
747 (with-temp-file (setq signature-file (mm-make-temp-file "pgg"))
748 (mm-insert-part signature))
749 (if (condition-case err
751 (pgg-verify-region (point-min) (point-max)
753 (goto-char (point-min))
754 (while (search-forward "\r\n" nil t)
755 (replace-match "\n" t t))
756 (mm-set-handle-multipart-parameter
757 mm-security-handle 'gnus-details
758 (concat (with-current-buffer pgg-output-buffer
760 (with-current-buffer pgg-errors-buffer
763 (mm-set-handle-multipart-parameter
764 mm-security-handle 'gnus-details (mml2015-format-error err))
767 (mm-set-handle-multipart-parameter
768 mm-security-handle 'gnus-details "Quit.")
771 (delete-file signature-file)
772 (mm-set-handle-multipart-parameter
773 mm-security-handle 'gnus-info
774 (with-current-buffer pgg-errors-buffer
775 (mml2015-gpg-extract-signature-details))))
776 (delete-file signature-file)
777 (mm-set-handle-multipart-parameter
778 mm-security-handle 'gnus-info "Failed")))))
781 (defun mml2015-pgg-clear-verify ()
782 (let ((pgg-errors-buffer mml2015-result-buffer)
783 (text (buffer-string))
784 (coding-system buffer-file-coding-system))
785 (if (condition-case err
787 (mm-with-unibyte-buffer
788 (insert (encode-coding-string text coding-system))
789 (pgg-verify-region (point-min) (point-max) nil t))
790 (goto-char (point-min))
791 (while (search-forward "\r\n" nil t)
792 (replace-match "\n" t t))
793 (mm-set-handle-multipart-parameter
794 mm-security-handle 'gnus-details
795 (concat (with-current-buffer pgg-output-buffer
797 (with-current-buffer pgg-errors-buffer
800 (mm-set-handle-multipart-parameter
801 mm-security-handle 'gnus-details (mml2015-format-error err))
804 (mm-set-handle-multipart-parameter
805 mm-security-handle 'gnus-details "Quit.")
807 (mm-set-handle-multipart-parameter
808 mm-security-handle 'gnus-info
809 (with-current-buffer pgg-errors-buffer
810 (mml2015-gpg-extract-signature-details)))
811 (mm-set-handle-multipart-parameter
812 mm-security-handle 'gnus-info "Failed"))))
814 (defun mml2015-pgg-sign (cont)
815 (let ((pgg-errors-buffer mml2015-result-buffer)
816 (boundary (mml-compute-boundary cont))
817 (pgg-default-user-id (or (message-options-get 'mml-sender)
818 pgg-default-user-id))
820 (unless (pgg-sign-region (point-min) (point-max))
821 (pop-to-buffer mml2015-result-buffer)
822 (error "Sign error"))
823 (goto-char (point-min))
824 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
826 (if (setq entry (assq 2 (pgg-parse-armor
827 (with-current-buffer pgg-output-buffer
829 (setq entry (assq 'hash-algorithm (cdr entry))))
830 (insert (format "\tmicalg=%s; "
832 (downcase (format "pgp-%s" (cdr entry)))
834 (insert "protocol=\"application/pgp-signature\"\n")
835 (insert (format "\n--%s\n" boundary))
836 (goto-char (point-max))
837 (insert (format "\n--%s\n" boundary))
838 (insert "Content-Type: application/pgp-signature\n\n")
839 (insert-buffer-substring pgg-output-buffer)
840 (goto-char (point-max))
841 (insert (format "--%s--\n" boundary))
842 (goto-char (point-max))))
844 (defun mml2015-pgg-encrypt (cont &optional sign)
845 (let ((pgg-errors-buffer mml2015-result-buffer)
846 (boundary (mml-compute-boundary cont)))
847 (unless (pgg-encrypt-region (point-min) (point-max)
850 (message-options-get 'message-recipients)
851 (message-options-set 'message-recipients
852 (read-string "Recipients: ")))
855 (pop-to-buffer mml2015-result-buffer)
856 (error "Encrypt error"))
857 (delete-region (point-min) (point-max))
858 (goto-char (point-min))
859 (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
861 (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
862 (insert (format "--%s\n" boundary))
863 (insert "Content-Type: application/pgp-encrypted\n\n")
864 (insert "Version: 1\n\n")
865 (insert (format "--%s\n" boundary))
866 (insert "Content-Type: application/octet-stream\n\n")
867 (insert-buffer-substring pgg-output-buffer)
868 (goto-char (point-max))
869 (insert (format "--%s--\n" boundary))
870 (goto-char (point-max))))
874 (defun mml2015-clean-buffer ()
875 (if (gnus-buffer-live-p mml2015-result-buffer)
876 (with-current-buffer mml2015-result-buffer
879 (setq mml2015-result-buffer
880 (gnus-get-buffer-create " *MML2015 Result*"))
883 (defsubst mml2015-clear-decrypt-function ()
884 (nth 6 (assq mml2015-use mml2015-function-alist)))
886 (defsubst mml2015-clear-verify-function ()
887 (nth 5 (assq mml2015-use mml2015-function-alist)))
890 (defun mml2015-decrypt (handle ctl)
891 (mml2015-clean-buffer)
892 (let ((func (nth 4 (assq mml2015-use mml2015-function-alist))))
894 (funcall func handle ctl)
898 (defun mml2015-decrypt-test (handle ctl)
902 (defun mml2015-verify (handle ctl)
903 (mml2015-clean-buffer)
904 (let ((func (nth 3 (assq mml2015-use mml2015-function-alist))))
906 (funcall func handle ctl)
910 (defun mml2015-verify-test (handle ctl)
914 (defun mml2015-encrypt (cont &optional sign)
915 (mml2015-clean-buffer)
916 (let ((func (nth 2 (assq mml2015-use mml2015-function-alist))))
918 (funcall func cont sign)
919 (error "Cannot find encrypt function"))))
922 (defun mml2015-sign (cont)
923 (mml2015-clean-buffer)
924 (let ((func (nth 1 (assq mml2015-use mml2015-function-alist))))
927 (error "Cannot find sign function"))))
930 (defun mml2015-self-encrypt ()
931 (mml2015-encrypt nil))
935 ;;; mml2015.el ends here