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"))
650 (defun mml2015-pgg-decrypt (handle ctl)
652 (let ((pgg-errors-buffer mml2015-result-buffer)
653 child handles result decrypt-status)
654 (unless (setq child (mm-find-part-by-type
656 "application/octet-stream" nil t))
657 (mm-set-handle-multipart-parameter
658 mm-security-handle 'gnus-info "Corrupted")
659 (throw 'error handle))
661 (mm-insert-part child)
662 (if (condition-case err
664 (pgg-decrypt-region (point-min) (point-max))
666 (with-current-buffer mml2015-result-buffer
668 (mm-set-handle-multipart-parameter
669 mm-security-handle 'gnus-details
672 (mm-set-handle-multipart-parameter
673 mm-security-handle 'gnus-details (mml2015-format-error err))
676 (mm-set-handle-multipart-parameter
677 mm-security-handle 'gnus-details "Quit.")
679 (with-current-buffer pgg-output-buffer
680 (goto-char (point-min))
681 (while (search-forward "\r\n" nil t)
682 (replace-match "\n" t t))
683 (setq handles (mm-dissect-buffer t))
684 (mm-destroy-parts handle)
685 (mm-set-handle-multipart-parameter
686 mm-security-handle 'gnus-info "OK")
687 (mm-set-handle-multipart-parameter
688 mm-security-handle 'gnus-details
689 (concat decrypt-status
690 (when (stringp (car handles))
691 "\n" (mm-handle-multipart-ctl-parameter
692 handles 'gnus-details))))
693 (if (listp (car handles))
696 (mm-set-handle-multipart-parameter
697 mm-security-handle 'gnus-info "Failed")
698 (throw 'error handle))))))
700 (defun mml2015-pgg-clear-decrypt ()
701 (let ((pgg-errors-buffer mml2015-result-buffer))
703 (pgg-decrypt-region (point-min) (point-max))
704 (mm-set-handle-multipart-parameter
705 mm-security-handle 'gnus-details
706 (with-current-buffer mml2015-result-buffer
710 (insert-buffer-substring pgg-output-buffer)
711 (goto-char (point-min))
712 (while (search-forward "\r\n" nil t)
713 (replace-match "\n" t t))
714 (mm-set-handle-multipart-parameter
715 mm-security-handle 'gnus-info "OK"))
716 (mm-set-handle-multipart-parameter
717 mm-security-handle 'gnus-info "Failed"))))
719 (defun mml2015-pgg-verify (handle ctl)
720 (let ((pgg-errors-buffer mml2015-result-buffer)
721 signature-file part signature)
722 (if (or (null (setq part (mm-find-raw-part-by-type
723 ctl (or (mm-handle-multipart-ctl-parameter
725 "application/pgp-signature")
727 (null (setq signature (mm-find-part-by-type
728 (cdr handle) "application/pgp-signature" nil t))))
730 (mm-set-handle-multipart-parameter
731 mm-security-handle 'gnus-info "Corrupted")
735 ;; Convert <LF> to <CR><LF> in verify mode. Sign and
736 ;; clearsign use --textmode. The conversion is not necessary.
737 ;; In clearverify, the conversion is not necessary either.
738 (goto-char (point-min))
741 (unless (eq (char-before) ?\r)
745 (with-temp-file (setq signature-file (mm-make-temp-file "pgg"))
746 (mm-insert-part signature))
747 (if (condition-case err
749 (pgg-verify-region (point-min) (point-max)
751 (goto-char (point-min))
752 (while (search-forward "\r\n" nil t)
753 (replace-match "\n" t t))
754 (mm-set-handle-multipart-parameter
755 mm-security-handle 'gnus-details
756 (concat (with-current-buffer pgg-output-buffer
758 (with-current-buffer pgg-errors-buffer
761 (mm-set-handle-multipart-parameter
762 mm-security-handle 'gnus-details (mml2015-format-error err))
765 (mm-set-handle-multipart-parameter
766 mm-security-handle 'gnus-details "Quit.")
769 (delete-file signature-file)
770 (mm-set-handle-multipart-parameter
771 mm-security-handle 'gnus-info
772 (with-current-buffer pgg-errors-buffer
773 (mml2015-gpg-extract-signature-details))))
774 (delete-file signature-file)
775 (mm-set-handle-multipart-parameter
776 mm-security-handle 'gnus-info "Failed")))))
779 (defun mml2015-pgg-clear-verify ()
780 (let ((pgg-errors-buffer mml2015-result-buffer)
781 (text (buffer-string))
782 (coding-system buffer-file-coding-system))
783 (if (condition-case err
785 (mm-with-unibyte-buffer
786 (insert (encode-coding-string text coding-system))
787 (pgg-verify-region (point-min) (point-max) nil t))
788 (goto-char (point-min))
789 (while (search-forward "\r\n" nil t)
790 (replace-match "\n" t t))
791 (mm-set-handle-multipart-parameter
792 mm-security-handle 'gnus-details
793 (concat (with-current-buffer pgg-output-buffer
795 (with-current-buffer pgg-errors-buffer
798 (mm-set-handle-multipart-parameter
799 mm-security-handle 'gnus-details (mml2015-format-error err))
802 (mm-set-handle-multipart-parameter
803 mm-security-handle 'gnus-details "Quit.")
805 (mm-set-handle-multipart-parameter
806 mm-security-handle 'gnus-info
807 (with-current-buffer pgg-errors-buffer
808 (mml2015-gpg-extract-signature-details)))
809 (mm-set-handle-multipart-parameter
810 mm-security-handle 'gnus-info "Failed"))))
812 (defun mml2015-pgg-sign (cont)
813 (let ((pgg-errors-buffer mml2015-result-buffer)
814 (boundary (mml-compute-boundary cont))
815 (pgg-default-user-id (or (message-options-get 'mml-sender)
816 pgg-default-user-id)))
817 (unless (pgg-sign-region (point-min) (point-max))
818 (pop-to-buffer mml2015-result-buffer)
819 (error "Sign error"))
820 (goto-char (point-min))
821 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
823 ;;; FIXME: what is the micalg?
824 (insert "\tmicalg=pgp-sha1; protocol=\"application/pgp-signature\"\n")
825 (insert (format "\n--%s\n" boundary))
826 (goto-char (point-max))
827 (insert (format "\n--%s\n" boundary))
828 (insert "Content-Type: application/pgp-signature\n\n")
829 (insert-buffer-substring pgg-output-buffer)
830 (goto-char (point-max))
831 (insert (format "--%s--\n" boundary))
832 (goto-char (point-max))))
834 (defun mml2015-pgg-encrypt (cont &optional sign)
835 (let ((pgg-errors-buffer mml2015-result-buffer)
836 (boundary (mml-compute-boundary cont)))
837 (unless (pgg-encrypt-region (point-min) (point-max)
840 (message-options-get 'message-recipients)
841 (message-options-set 'message-recipients
842 (read-string "Recipients: ")))
845 (pop-to-buffer mml2015-result-buffer)
846 (error "Encrypt error"))
847 (delete-region (point-min) (point-max))
848 (goto-char (point-min))
849 (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
851 (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
852 (insert (format "--%s\n" boundary))
853 (insert "Content-Type: application/pgp-encrypted\n\n")
854 (insert "Version: 1\n\n")
855 (insert (format "--%s\n" boundary))
856 (insert "Content-Type: application/octet-stream\n\n")
857 (insert-buffer-substring pgg-output-buffer)
858 (goto-char (point-max))
859 (insert (format "--%s--\n" boundary))
860 (goto-char (point-max))))
864 (defun mml2015-clean-buffer ()
865 (if (gnus-buffer-live-p mml2015-result-buffer)
866 (with-current-buffer mml2015-result-buffer
869 (setq mml2015-result-buffer
870 (gnus-get-buffer-create "*MML2015 Result*"))
873 (defsubst mml2015-clear-decrypt-function ()
874 (nth 6 (assq mml2015-use mml2015-function-alist)))
876 (defsubst mml2015-clear-verify-function ()
877 (nth 5 (assq mml2015-use mml2015-function-alist)))
880 (defun mml2015-decrypt (handle ctl)
881 (mml2015-clean-buffer)
882 (let ((func (nth 4 (assq mml2015-use mml2015-function-alist))))
884 (funcall func handle ctl)
888 (defun mml2015-decrypt-test (handle ctl)
892 (defun mml2015-verify (handle ctl)
893 (mml2015-clean-buffer)
894 (let ((func (nth 3 (assq mml2015-use mml2015-function-alist))))
896 (funcall func handle ctl)
900 (defun mml2015-verify-test (handle ctl)
904 (defun mml2015-encrypt (cont &optional sign)
905 (mml2015-clean-buffer)
906 (let ((func (nth 2 (assq mml2015-use mml2015-function-alist))))
908 (funcall func cont sign)
909 (error "Cannot find encrypt function"))))
912 (defun mml2015-sign (cont)
913 (mml2015-clean-buffer)
914 (let ((func (nth 1 (assq mml2015-use mml2015-function-alist))))
917 (error "Cannot find sign function"))))
920 (defun mml2015-self-encrypt ()
921 (mml2015-encrypt nil))
925 ;;; mml2015.el ends here