1 ;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP)
2 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
4 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
5 ;; Keywords: PGP MIME MML
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published
11 ;; by the Free Software Foundation; either version 2, or (at your
12 ;; option) any later version.
14 ;; GNU Emacs is distributed in the hope that it will be useful, but
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 ;; General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
26 ;; RFC 2015 is updated by RFC 3156, this file should be compatible
31 (eval-when-compile (require 'cl))
36 (defvar mml2015-use (or
39 ;; Avoid the "Recursive load suspected" error
41 (let ((recursive-load-depth-limit 100))
43 (and (fboundp 'pgg-sign-region)
48 (and (fboundp 'gpg-sign-detached)
52 (and (fboundp 'mc-encrypt-generic)
53 (fboundp 'mc-sign-generic)
54 (fboundp 'mc-cleanup-recipient-headers)
56 "The package used for PGP/MIME.
57 Valid packages include `pgg', `gpg' and `mailcrypt'.")
59 ;; Something is not RFC2015.
60 (defvar mml2015-function-alist
61 '((mailcrypt mml2015-mailcrypt-sign
62 mml2015-mailcrypt-encrypt
63 mml2015-mailcrypt-verify
64 mml2015-mailcrypt-decrypt
65 mml2015-mailcrypt-clear-verify
66 mml2015-mailcrypt-clear-decrypt)
71 mml2015-gpg-clear-verify
72 mml2015-gpg-clear-decrypt)
77 mml2015-pgg-clear-verify
78 mml2015-pgg-clear-decrypt))
79 "Alist of PGP/MIME functions.")
81 (defvar mml2015-result-buffer nil)
83 (defcustom mml2015-unabbrev-trust-alist
84 '(("TRUST_UNDEFINED" . nil)
86 ("TRUST_MARGINAL" . t)
88 ("TRUST_ULTIMATE" . t))
89 "Map GnuPG trust output values to a boolean saying if you trust the key."
92 :type '(repeat (cons (regexp :tag "GnuPG output regexp")
93 (boolean :tag "Trust key"))))
98 (autoload 'mailcrypt-decrypt "mailcrypt")
99 (autoload 'mailcrypt-verify "mailcrypt")
100 (autoload 'mc-pgp-always-sign "mailcrypt")
101 (autoload 'mc-encrypt-generic "mc-toplev")
102 (autoload 'mc-cleanup-recipient-headers "mc-toplev")
103 (autoload 'mc-sign-generic "mc-toplev"))
106 (defvar mc-default-scheme)
109 (defvar mml2015-decrypt-function 'mailcrypt-decrypt)
110 (defvar mml2015-verify-function 'mailcrypt-verify)
112 (defun mml2015-format-error (err)
113 (if (stringp (cadr err))
115 (format "%S" (cdr err))))
117 (defun mml2015-mailcrypt-decrypt (handle ctl)
119 (let (child handles result)
120 (unless (setq child (mm-find-part-by-type
122 "application/octet-stream" nil t))
123 (mm-set-handle-multipart-parameter
124 mm-security-handle 'gnus-info "Corrupted")
125 (throw 'error handle))
127 (mm-insert-part child)
130 (funcall mml2015-decrypt-function)
132 (mm-set-handle-multipart-parameter
133 mm-security-handle 'gnus-details (mml2015-format-error err))
136 (mm-set-handle-multipart-parameter
137 mm-security-handle 'gnus-details "Quit.")
140 (mm-set-handle-multipart-parameter
141 mm-security-handle 'gnus-info "Failed")
142 (throw 'error handle))
143 (setq handles (mm-dissect-buffer t)))
144 (mm-destroy-parts handle)
145 (mm-set-handle-multipart-parameter
146 mm-security-handle 'gnus-info
148 (let ((sig (with-current-buffer mml2015-result-buffer
149 (mml2015-gpg-extract-signature-details))))
150 (concat ", Signer: " sig))))
151 (if (listp (car handles))
155 (defun mml2015-mailcrypt-clear-decrypt ()
159 (funcall mml2015-decrypt-function)
161 (mm-set-handle-multipart-parameter
162 mm-security-handle 'gnus-details (mml2015-format-error err))
165 (mm-set-handle-multipart-parameter
166 mm-security-handle 'gnus-details "Quit.")
169 (mm-set-handle-multipart-parameter
170 mm-security-handle 'gnus-info "OK")
171 (mm-set-handle-multipart-parameter
172 mm-security-handle 'gnus-info "Failed"))))
174 (defun mml2015-fix-micalg (alg)
176 ;; Mutt/1.2.5i has seen sending micalg=php-sha1
177 (upcase (if (string-match "^p[gh]p-" alg)
178 (substring alg (match-end 0))
181 (defun mml2015-mailcrypt-verify (handle ctl)
184 (unless (setq part (mm-find-raw-part-by-type
185 ctl (or (mm-handle-multipart-ctl-parameter
187 "application/pgp-signature")
189 (mm-set-handle-multipart-parameter
190 mm-security-handle 'gnus-info "Corrupted")
191 (throw 'error handle))
193 (insert "-----BEGIN PGP SIGNED MESSAGE-----\n")
194 (insert (format "Hash: %s\n\n"
195 (or (mml2015-fix-micalg
196 (mm-handle-multipart-ctl-parameter
200 (narrow-to-region (point) (point))
202 (goto-char (point-min))
204 (if (looking-at "^-")
207 (unless (setq part (mm-find-part-by-type
208 (cdr handle) "application/pgp-signature" nil t))
209 (mm-set-handle-multipart-parameter
210 mm-security-handle 'gnus-info "Corrupted")
211 (throw 'error handle))
213 (narrow-to-region (point) (point))
214 (mm-insert-part part)
215 (goto-char (point-min))
216 (if (re-search-forward "^-----BEGIN PGP [^-]+-----\r?$" nil t)
217 (replace-match "-----BEGIN PGP SIGNATURE-----" t t))
218 (if (re-search-forward "^-----END PGP [^-]+-----\r?$" nil t)
219 (replace-match "-----END PGP SIGNATURE-----" t t)))
220 (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
221 (unless (condition-case err
223 (funcall mml2015-verify-function)
224 (if (get-buffer " *mailcrypt stderr temp")
225 (mm-set-handle-multipart-parameter
226 mm-security-handle 'gnus-details
227 (with-current-buffer " *mailcrypt stderr temp"
229 (if (get-buffer " *mailcrypt stdout temp")
230 (kill-buffer " *mailcrypt stdout temp"))
231 (if (get-buffer " *mailcrypt stderr temp")
232 (kill-buffer " *mailcrypt stderr temp"))
233 (if (get-buffer " *mailcrypt status temp")
234 (kill-buffer " *mailcrypt status temp"))
235 (if (get-buffer mc-gpg-debug-buffer)
236 (kill-buffer mc-gpg-debug-buffer)))
238 (mm-set-handle-multipart-parameter
239 mm-security-handle 'gnus-details (mml2015-format-error err))
242 (mm-set-handle-multipart-parameter
243 mm-security-handle 'gnus-details "Quit.")
245 (mm-set-handle-multipart-parameter
246 mm-security-handle 'gnus-info "Failed")
247 (throw 'error handle))))
248 (mm-set-handle-multipart-parameter
249 mm-security-handle 'gnus-info "OK")
252 (defun mml2015-mailcrypt-clear-verify ()
253 (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
254 (if (condition-case err
256 (funcall mml2015-verify-function)
257 (if (get-buffer " *mailcrypt stderr temp")
258 (mm-set-handle-multipart-parameter
259 mm-security-handle 'gnus-details
260 (with-current-buffer " *mailcrypt stderr temp"
262 (if (get-buffer " *mailcrypt stdout temp")
263 (kill-buffer " *mailcrypt stdout temp"))
264 (if (get-buffer " *mailcrypt stderr temp")
265 (kill-buffer " *mailcrypt stderr temp"))
266 (if (get-buffer " *mailcrypt status temp")
267 (kill-buffer " *mailcrypt status temp"))
268 (if (get-buffer mc-gpg-debug-buffer)
269 (kill-buffer mc-gpg-debug-buffer)))
271 (mm-set-handle-multipart-parameter
272 mm-security-handle 'gnus-details (mml2015-format-error err))
275 (mm-set-handle-multipart-parameter
276 mm-security-handle 'gnus-details "Quit.")
278 (mm-set-handle-multipart-parameter
279 mm-security-handle 'gnus-info "OK")
280 (mm-set-handle-multipart-parameter
281 mm-security-handle 'gnus-info "Failed"))))
283 (defun mml2015-mailcrypt-sign (cont)
284 (mc-sign-generic (message-options-get 'message-sender)
286 (let ((boundary (mml-compute-boundary cont))
288 (goto-char (point-min))
289 (unless (re-search-forward "^-----BEGIN PGP SIGNED MESSAGE-----\r?$" nil t)
290 (error "Cannot find signed begin line"))
291 (goto-char (match-beginning 0))
293 (unless (looking-at "Hash:[ \t]*\\([a-zA-Z0-9]+\\)")
294 (error "Cannot not find PGP hash"))
295 (setq hash (match-string 1))
296 (unless (re-search-forward "^$" nil t)
297 (error "Cannot not find PGP message"))
299 (delete-region (point-min) (point))
300 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
302 (insert (format "\tmicalg=pgp-%s; protocol=\"application/pgp-signature\"\n"
304 (insert (format "\n--%s\n" boundary))
306 (goto-char (point-max))
307 (unless (re-search-backward "^-----END PGP SIGNATURE-----\r?$" nil t)
308 (error "Cannot find signature part"))
309 (replace-match "-----END PGP MESSAGE-----" t t)
310 (goto-char (match-beginning 0))
311 (unless (re-search-backward "^-----BEGIN PGP SIGNATURE-----\r?$"
313 (error "Cannot find signature part"))
314 (replace-match "-----BEGIN PGP MESSAGE-----" t t)
315 (goto-char (match-beginning 0))
317 (narrow-to-region point (point))
319 (while (re-search-forward "^- -" nil t)
320 (replace-match "-" t t))
321 (goto-char (point-max)))
322 (insert (format "--%s\n" boundary))
323 (insert "Content-Type: application/pgp-signature\n\n")
324 (goto-char (point-max))
325 (insert (format "--%s--\n" boundary))
326 (goto-char (point-max))))
328 (defun mml2015-mailcrypt-encrypt (cont &optional sign)
329 (let ((mc-pgp-always-sign
330 (or mc-pgp-always-sign
332 (eq t (or (message-options-get 'message-sign-encrypt)
334 'message-sign-encrypt
335 (or (y-or-n-p "Sign the message? ")
338 (mm-with-unibyte-current-buffer
340 (or (message-options-get 'message-recipients)
341 (message-options-set 'message-recipients
342 (mc-cleanup-recipient-headers
343 (read-string "Recipients: "))))
345 (message-options-get 'message-sender))))
346 (goto-char (point-min))
347 (unless (looking-at "-----BEGIN PGP MESSAGE-----")
348 (error "Fail to encrypt the message"))
349 (let ((boundary (mml-compute-boundary cont)))
350 (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
352 (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
353 (insert (format "--%s\n" boundary))
354 (insert "Content-Type: application/pgp-encrypted\n\n")
355 (insert "Version: 1\n\n")
356 (insert (format "--%s\n" boundary))
357 (insert "Content-Type: application/octet-stream\n\n")
358 (goto-char (point-max))
359 (insert (format "--%s--\n" boundary))
360 (goto-char (point-max))))
365 (autoload 'gpg-decrypt "gpg")
366 (autoload 'gpg-verify "gpg")
367 (autoload 'gpg-verify-cleartext "gpg")
368 (autoload 'gpg-sign-detached "gpg")
369 (autoload 'gpg-sign-encrypt "gpg")
370 (autoload 'gpg-encrypt "gpg")
371 (autoload 'gpg-passphrase-read "gpg"))
373 (defun mml2015-gpg-passphrase ()
374 (or (message-options-get 'gpg-passphrase)
375 (message-options-set 'gpg-passphrase (gpg-passphrase-read))))
377 (defun mml2015-gpg-decrypt-1 ()
378 (let ((cipher (current-buffer)) plain result)
379 (if (with-temp-buffer
381 (gpg-decrypt cipher (setq plain (current-buffer))
382 mml2015-result-buffer nil)
383 (mm-set-handle-multipart-parameter
384 mm-security-handle 'gnus-details
385 (with-current-buffer mml2015-result-buffer
389 (insert-buffer-substring plain)
390 (goto-char (point-min))
391 (while (search-forward "\r\n" nil t)
392 (replace-match "\n" t t))))
394 ;; Some wrong with the return value, check plain text buffer.
395 (if (> (point-max) (point-min))
399 (defun mml2015-gpg-decrypt (handle ctl)
400 (let ((mml2015-decrypt-function 'mml2015-gpg-decrypt-1))
401 (mml2015-mailcrypt-decrypt handle ctl)))
403 (defun mml2015-gpg-clear-decrypt ()
405 (setq result (mml2015-gpg-decrypt-1))
407 (mm-set-handle-multipart-parameter
408 mm-security-handle 'gnus-info "OK")
409 (mm-set-handle-multipart-parameter
410 mm-security-handle 'gnus-info "Failed"))))
412 (defun mml2015-gpg-pretty-print-fpr (fingerprint)
414 (fpr-length (string-width fingerprint))
417 (setq fingerprint (string-to-list fingerprint))
419 (setq fpr-length (- fpr-length 4))
420 (setq slice (butlast fingerprint fpr-length))
421 (setq fingerprint (nthcdr 4 fingerprint))
422 (setq n-slice (1+ n-slice))
428 (otherwise (concat " " slice))))))
431 (defun mml2015-gpg-extract-signature-details ()
432 (goto-char (point-min))
433 (let* ((expired (re-search-forward
434 "^\\[GNUPG:\\] SIGEXPIRED$"
436 (signer (and (re-search-forward
437 "^\\[GNUPG:\\] GOODSIG \\([0-9A-Za-z]*\\) \\(.*\\)$"
439 (cons (match-string 1) (match-string 2))))
440 (fprint (and (re-search-forward
441 "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) "
444 (trust (and (re-search-forward
445 "^\\[GNUPG:\\] \\(TRUST_.*\\)$"
449 (cdr (assoc trust mml2015-unabbrev-trust-alist))))
450 (cond ((and signer fprint)
452 (unless trust-good-enough-p
453 (concat "\nUntrusted, Fingerprint: "
454 (mml2015-gpg-pretty-print-fpr fprint)))
456 (format "\nWARNING: Signature from expired key (%s)"
459 "^\\(gpg: \\)?Good signature from \"\\(.*\\)\"$" nil t)
462 "From unknown user"))))
464 (defun mml2015-gpg-verify (handle ctl)
466 (let (part message signature info-is-set-p)
467 (unless (setq part (mm-find-raw-part-by-type
468 ctl (or (mm-handle-multipart-ctl-parameter
470 "application/pgp-signature")
472 (mm-set-handle-multipart-parameter
473 mm-security-handle 'gnus-info "Corrupted")
474 (throw 'error handle))
476 (setq message (current-buffer))
478 ;; Convert <LF> to <CR><LF> in verify mode. Sign and
479 ;; clearsign use --textmode. The conversion is not necessary.
480 ;; In clearverify, the conversion is not necessary either.
481 (goto-char (point-min))
484 (unless (eq (char-before) ?\r)
489 (setq signature (current-buffer))
490 (unless (setq part (mm-find-part-by-type
491 (cdr handle) "application/pgp-signature" nil t))
492 (mm-set-handle-multipart-parameter
493 mm-security-handle 'gnus-info "Corrupted")
494 (throw 'error handle))
495 (mm-insert-part part)
496 (unless (condition-case err
498 (gpg-verify message signature mml2015-result-buffer)
499 (mm-set-handle-multipart-parameter
500 mm-security-handle 'gnus-details
501 (with-current-buffer mml2015-result-buffer
504 (mm-set-handle-multipart-parameter
505 mm-security-handle 'gnus-details (mml2015-format-error err))
506 (mm-set-handle-multipart-parameter
507 mm-security-handle 'gnus-info "Error.")
508 (setq info-is-set-p t)
511 (mm-set-handle-multipart-parameter
512 mm-security-handle 'gnus-details "Quit.")
513 (mm-set-handle-multipart-parameter
514 mm-security-handle 'gnus-info "Quit.")
515 (setq info-is-set-p t)
517 (unless info-is-set-p
518 (mm-set-handle-multipart-parameter
519 mm-security-handle 'gnus-info "Failed"))
520 (throw 'error handle)))
521 (mm-set-handle-multipart-parameter
522 mm-security-handle 'gnus-info
523 (with-current-buffer mml2015-result-buffer
524 (mml2015-gpg-extract-signature-details))))
527 (defun mml2015-gpg-clear-verify ()
528 (if (condition-case err
530 (gpg-verify-cleartext (current-buffer) mml2015-result-buffer)
531 (mm-set-handle-multipart-parameter
532 mm-security-handle 'gnus-details
533 (with-current-buffer mml2015-result-buffer
536 (mm-set-handle-multipart-parameter
537 mm-security-handle 'gnus-details (mml2015-format-error err))
540 (mm-set-handle-multipart-parameter
541 mm-security-handle 'gnus-details "Quit.")
543 (mm-set-handle-multipart-parameter
544 mm-security-handle 'gnus-info
545 (with-current-buffer mml2015-result-buffer
546 (mml2015-gpg-extract-signature-details)))
547 (mm-set-handle-multipart-parameter
548 mm-security-handle 'gnus-info "Failed")))
550 (defun mml2015-gpg-sign (cont)
551 (let ((boundary (mml-compute-boundary cont))
552 (text (current-buffer)) signature)
553 (goto-char (point-max))
557 (unless (gpg-sign-detached text (setq signature (current-buffer))
558 mml2015-result-buffer
560 (message-options-get 'message-sender)
561 t t) ; armor & textmode
562 (unless (> (point-max) (point-min))
563 (pop-to-buffer mml2015-result-buffer)
564 (error "Sign error")))
565 (goto-char (point-min))
566 (while (re-search-forward "\r+$" nil t)
567 (replace-match "" t t))
569 (goto-char (point-min))
570 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
572 ;;; FIXME: what is the micalg?
573 (insert "\tmicalg=pgp-sha1; protocol=\"application/pgp-signature\"\n")
574 (insert (format "\n--%s\n" boundary))
575 (goto-char (point-max))
576 (insert (format "\n--%s\n" boundary))
577 (insert "Content-Type: application/pgp-signature\n\n")
578 (insert-buffer-substring signature)
579 (goto-char (point-max))
580 (insert (format "--%s--\n" boundary))
581 (goto-char (point-max)))))
583 (defun mml2015-gpg-encrypt (cont &optional sign)
584 (let ((boundary (mml-compute-boundary cont))
585 (text (current-buffer))
587 (mm-with-unibyte-current-buffer
589 ;; set up a function to call the correct gpg encrypt routine
590 ;; with the right arguments. (FIXME: this should be done
592 (flet ((gpg-encrypt-func
593 (sign plaintext ciphertext result recipients &optional
594 passphrase sign-with-key armor textmode)
597 plaintext ciphertext result recipients passphrase
598 sign-with-key armor textmode)
600 plaintext ciphertext result recipients passphrase
602 (unless (gpg-encrypt-func
603 sign ; passed in when using signencrypt
604 text (setq cipher (current-buffer))
605 mml2015-result-buffer
608 (message-options-get 'message-recipients)
609 (message-options-set 'message-recipients
610 (read-string "Recipients: ")))
613 (message-options-get 'message-sender)
614 t t) ; armor & textmode
615 (unless (> (point-max) (point-min))
616 (pop-to-buffer mml2015-result-buffer)
617 (error "Encrypt error"))))
618 (goto-char (point-min))
619 (while (re-search-forward "\r+$" nil t)
620 (replace-match "" t t))
622 (delete-region (point-min) (point-max))
623 (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
625 (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
626 (insert (format "--%s\n" boundary))
627 (insert "Content-Type: application/pgp-encrypted\n\n")
628 (insert "Version: 1\n\n")
629 (insert (format "--%s\n" boundary))
630 (insert "Content-Type: application/octet-stream\n\n")
631 (insert-buffer-substring cipher)
632 (goto-char (point-max))
633 (insert (format "--%s--\n" boundary))
634 (goto-char (point-max))))))
639 (defvar pgg-errors-buffer)
640 (defvar pgg-output-buffer))
643 (autoload 'pgg-decrypt-region "pgg")
644 (autoload 'pgg-verify-region "pgg")
645 (autoload 'pgg-sign-region "pgg")
646 (autoload 'pgg-encrypt-region "pgg"))
648 (defun mml2015-pgg-decrypt (handle ctl)
650 (let ((pgg-errors-buffer mml2015-result-buffer)
651 child handles result decrypt-status)
652 (unless (setq child (mm-find-part-by-type
654 "application/octet-stream" nil t))
655 (mm-set-handle-multipart-parameter
656 mm-security-handle 'gnus-info "Corrupted")
657 (throw 'error handle))
659 (mm-insert-part child)
660 (if (condition-case err
662 (pgg-decrypt-region (point-min) (point-max))
664 (with-current-buffer mml2015-result-buffer
666 (mm-set-handle-multipart-parameter
667 mm-security-handle 'gnus-details
670 (mm-set-handle-multipart-parameter
671 mm-security-handle 'gnus-details (mml2015-format-error err))
674 (mm-set-handle-multipart-parameter
675 mm-security-handle 'gnus-details "Quit.")
677 (with-current-buffer pgg-output-buffer
678 (goto-char (point-min))
679 (while (search-forward "\r\n" nil t)
680 (replace-match "\n" t t))
681 (setq handles (mm-dissect-buffer t))
682 (mm-destroy-parts handle)
683 (mm-set-handle-multipart-parameter
684 mm-security-handle 'gnus-info "OK")
685 (mm-set-handle-multipart-parameter
686 mm-security-handle 'gnus-details
687 (concat decrypt-status
688 (when (stringp (car handles))
689 "\n" (mm-handle-multipart-ctl-parameter
690 handles 'gnus-details))))
691 (if (listp (car handles))
694 (mm-set-handle-multipart-parameter
695 mm-security-handle 'gnus-info "Failed")
696 (throw 'error handle))))))
698 (defun mml2015-pgg-clear-decrypt ()
699 (let ((pgg-errors-buffer mml2015-result-buffer))
701 (pgg-decrypt-region (point-min) (point-max))
702 (mm-set-handle-multipart-parameter
703 mm-security-handle 'gnus-details
704 (with-current-buffer mml2015-result-buffer
708 (insert-buffer-substring pgg-output-buffer)
709 (goto-char (point-min))
710 (while (search-forward "\r\n" nil t)
711 (replace-match "\n" t t))
712 (mm-set-handle-multipart-parameter
713 mm-security-handle 'gnus-info "OK"))
714 (mm-set-handle-multipart-parameter
715 mm-security-handle 'gnus-info "Failed"))))
717 (defun mml2015-pgg-verify (handle ctl)
718 (let ((pgg-errors-buffer mml2015-result-buffer)
719 signature-file part signature)
720 (if (or (null (setq part (mm-find-raw-part-by-type
721 ctl (or (mm-handle-multipart-ctl-parameter
723 "application/pgp-signature")
725 (null (setq signature (mm-find-part-by-type
726 (cdr handle) "application/pgp-signature" nil t))))
728 (mm-set-handle-multipart-parameter
729 mm-security-handle 'gnus-info "Corrupted")
733 ;; Convert <LF> to <CR><LF> in verify mode. Sign and
734 ;; clearsign use --textmode. The conversion is not necessary.
735 ;; In clearverify, the conversion is not necessary either.
736 (goto-char (point-min))
739 (unless (eq (char-before) ?\r)
743 (with-temp-file (setq signature-file (mm-make-temp-file "pgg"))
744 (mm-insert-part signature))
745 (if (condition-case err
747 (pgg-verify-region (point-min) (point-max)
749 (goto-char (point-min))
750 (while (search-forward "\r\n" nil t)
751 (replace-match "\n" t t))
752 (mm-set-handle-multipart-parameter
753 mm-security-handle 'gnus-details
754 (concat (with-current-buffer pgg-output-buffer
756 (with-current-buffer pgg-errors-buffer
759 (mm-set-handle-multipart-parameter
760 mm-security-handle 'gnus-details (mml2015-format-error err))
763 (mm-set-handle-multipart-parameter
764 mm-security-handle 'gnus-details "Quit.")
767 (delete-file signature-file)
768 (mm-set-handle-multipart-parameter
769 mm-security-handle 'gnus-info
770 (with-current-buffer pgg-errors-buffer
771 (mml2015-gpg-extract-signature-details))))
772 (delete-file signature-file)
773 (mm-set-handle-multipart-parameter
774 mm-security-handle 'gnus-info "Failed")))))
777 (defun mml2015-pgg-clear-verify ()
778 (let ((pgg-errors-buffer mml2015-result-buffer)
779 (text (buffer-string))
780 (coding-system buffer-file-coding-system))
781 (if (condition-case err
783 (mm-with-unibyte-buffer
784 (insert (encode-coding-string text coding-system))
785 (pgg-verify-region (point-min) (point-max) nil t))
786 (goto-char (point-min))
787 (while (search-forward "\r\n" nil t)
788 (replace-match "\n" t t))
789 (mm-set-handle-multipart-parameter
790 mm-security-handle 'gnus-details
791 (concat (with-current-buffer pgg-output-buffer
793 (with-current-buffer pgg-errors-buffer
796 (mm-set-handle-multipart-parameter
797 mm-security-handle 'gnus-details (mml2015-format-error err))
800 (mm-set-handle-multipart-parameter
801 mm-security-handle 'gnus-details "Quit.")
803 (mm-set-handle-multipart-parameter
804 mm-security-handle 'gnus-info
805 (with-current-buffer pgg-errors-buffer
806 (mml2015-gpg-extract-signature-details)))
807 (mm-set-handle-multipart-parameter
808 mm-security-handle 'gnus-info "Failed"))))
810 (defun mml2015-pgg-sign (cont)
811 (let ((pgg-errors-buffer mml2015-result-buffer)
812 (boundary (mml-compute-boundary cont))
813 (pgg-default-user-id (or (message-options-get 'mml-sender)
814 pgg-default-user-id)))
815 (unless (pgg-sign-region (point-min) (point-max))
816 (pop-to-buffer mml2015-result-buffer)
817 (error "Sign error"))
818 (goto-char (point-min))
819 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
821 ;;; FIXME: what is the micalg?
822 (insert "\tmicalg=pgp-sha1; protocol=\"application/pgp-signature\"\n")
823 (insert (format "\n--%s\n" boundary))
824 (goto-char (point-max))
825 (insert (format "\n--%s\n" boundary))
826 (insert "Content-Type: application/pgp-signature\n\n")
827 (insert-buffer-substring pgg-output-buffer)
828 (goto-char (point-max))
829 (insert (format "--%s--\n" boundary))
830 (goto-char (point-max))))
832 (defun mml2015-pgg-encrypt (cont &optional sign)
833 (let ((pgg-errors-buffer mml2015-result-buffer)
834 (boundary (mml-compute-boundary cont)))
835 (unless (pgg-encrypt-region (point-min) (point-max)
838 (message-options-get 'message-recipients)
839 (message-options-set 'message-recipients
840 (read-string "Recipients: ")))
843 (pop-to-buffer mml2015-result-buffer)
844 (error "Encrypt error"))
845 (delete-region (point-min) (point-max))
846 (goto-char (point-min))
847 (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
849 (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
850 (insert (format "--%s\n" boundary))
851 (insert "Content-Type: application/pgp-encrypted\n\n")
852 (insert "Version: 1\n\n")
853 (insert (format "--%s\n" boundary))
854 (insert "Content-Type: application/octet-stream\n\n")
855 (insert-buffer-substring pgg-output-buffer)
856 (goto-char (point-max))
857 (insert (format "--%s--\n" boundary))
858 (goto-char (point-max))))
862 (defun mml2015-clean-buffer ()
863 (if (gnus-buffer-live-p mml2015-result-buffer)
864 (with-current-buffer mml2015-result-buffer
867 (setq mml2015-result-buffer
868 (gnus-get-buffer-create "*MML2015 Result*"))
871 (defsubst mml2015-clear-decrypt-function ()
872 (nth 6 (assq mml2015-use mml2015-function-alist)))
874 (defsubst mml2015-clear-verify-function ()
875 (nth 5 (assq mml2015-use mml2015-function-alist)))
878 (defun mml2015-decrypt (handle ctl)
879 (mml2015-clean-buffer)
880 (let ((func (nth 4 (assq mml2015-use mml2015-function-alist))))
882 (funcall func handle ctl)
886 (defun mml2015-decrypt-test (handle ctl)
890 (defun mml2015-verify (handle ctl)
891 (mml2015-clean-buffer)
892 (let ((func (nth 3 (assq mml2015-use mml2015-function-alist))))
894 (funcall func handle ctl)
898 (defun mml2015-verify-test (handle ctl)
902 (defun mml2015-encrypt (cont &optional sign)
903 (mml2015-clean-buffer)
904 (let ((func (nth 2 (assq mml2015-use mml2015-function-alist))))
906 (funcall func cont sign)
907 (error "Cannot find encrypt function"))))
910 (defun mml2015-sign (cont)
911 (mml2015-clean-buffer)
912 (let ((func (nth 1 (assq mml2015-use mml2015-function-alist))))
915 (error "Cannot find sign function"))))
918 (defun mml2015-self-encrypt ()
919 (mml2015-encrypt nil))
923 ;;; mml2015.el ends here