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 mc-pgp-always-sign)
40 (defvar mml2015-use (or
43 ;; Avoid the "Recursive load suspected" error
45 (let ((recursive-load-depth-limit 100))
47 (and (fboundp 'pgg-sign-region)
52 (and (fboundp 'gpg-sign-detached)
56 (and (fboundp 'mc-encrypt-generic)
57 (fboundp 'mc-sign-generic)
58 (fboundp 'mc-cleanup-recipient-headers)
60 "The package used for PGP/MIME.
61 Valid packages include `pgg', `gpg' and `mailcrypt'.")
63 ;; Something is not RFC2015.
64 (defvar mml2015-function-alist
65 '((mailcrypt mml2015-mailcrypt-sign
66 mml2015-mailcrypt-encrypt
67 mml2015-mailcrypt-verify
68 mml2015-mailcrypt-decrypt
69 mml2015-mailcrypt-clear-verify
70 mml2015-mailcrypt-clear-decrypt)
75 mml2015-gpg-clear-verify
76 mml2015-gpg-clear-decrypt)
81 mml2015-pgg-clear-verify
82 mml2015-pgg-clear-decrypt))
83 "Alist of PGP/MIME functions.")
85 (defvar mml2015-result-buffer nil)
87 (defcustom mml2015-unabbrev-trust-alist
88 '(("TRUST_UNDEFINED" . nil)
90 ("TRUST_MARGINAL" . t)
92 ("TRUST_ULTIMATE" . t))
93 "Map GnuPG trust output values to a boolean saying if you trust the key."
96 :type '(repeat (cons (regexp :tag "GnuPG output regexp")
97 (boolean :tag "Trust key"))))
102 (autoload 'mailcrypt-decrypt "mailcrypt")
103 (autoload 'mailcrypt-verify "mailcrypt")
104 (autoload 'mc-pgp-always-sign "mailcrypt")
105 (autoload 'mc-encrypt-generic "mc-toplev")
106 (autoload 'mc-cleanup-recipient-headers "mc-toplev")
107 (autoload 'mc-sign-generic "mc-toplev"))
110 (defvar mc-default-scheme)
113 (defvar mml2015-decrypt-function 'mailcrypt-decrypt)
114 (defvar mml2015-verify-function 'mailcrypt-verify)
116 (defun mml2015-format-error (err)
117 (if (stringp (cadr err))
119 (format "%S" (cdr err))))
121 (defun mml2015-mailcrypt-decrypt (handle ctl)
123 (let (child handles result)
124 (unless (setq child (mm-find-part-by-type
126 "application/octet-stream" nil t))
127 (mm-set-handle-multipart-parameter
128 mm-security-handle 'gnus-info "Corrupted")
129 (throw 'error handle))
131 (mm-insert-part child)
134 (funcall mml2015-decrypt-function)
136 (mm-set-handle-multipart-parameter
137 mm-security-handle 'gnus-details (mml2015-format-error err))
140 (mm-set-handle-multipart-parameter
141 mm-security-handle 'gnus-details "Quit.")
144 (mm-set-handle-multipart-parameter
145 mm-security-handle 'gnus-info "Failed")
146 (throw 'error handle))
147 (setq handles (mm-dissect-buffer t)))
148 (mm-destroy-parts handle)
149 (mm-set-handle-multipart-parameter
150 mm-security-handle 'gnus-info
152 (let ((sig (with-current-buffer mml2015-result-buffer
153 (mml2015-gpg-extract-signature-details))))
154 (concat ", Signer: " sig))))
155 (if (listp (car handles))
159 (defun mml2015-mailcrypt-clear-decrypt ()
163 (funcall mml2015-decrypt-function)
165 (mm-set-handle-multipart-parameter
166 mm-security-handle 'gnus-details (mml2015-format-error err))
169 (mm-set-handle-multipart-parameter
170 mm-security-handle 'gnus-details "Quit.")
173 (mm-set-handle-multipart-parameter
174 mm-security-handle 'gnus-info "OK")
175 (mm-set-handle-multipart-parameter
176 mm-security-handle 'gnus-info "Failed"))))
178 (defun mml2015-fix-micalg (alg)
180 ;; Mutt/1.2.5i has seen sending micalg=php-sha1
181 (upcase (if (string-match "^p[gh]p-" alg)
182 (substring alg (match-end 0))
185 (defun mml2015-mailcrypt-verify (handle ctl)
188 (unless (setq part (mm-find-raw-part-by-type
189 ctl (or (mm-handle-multipart-ctl-parameter
191 "application/pgp-signature")
193 (mm-set-handle-multipart-parameter
194 mm-security-handle 'gnus-info "Corrupted")
195 (throw 'error handle))
197 (insert "-----BEGIN PGP SIGNED MESSAGE-----\n")
198 (insert (format "Hash: %s\n\n"
199 (or (mml2015-fix-micalg
200 (mm-handle-multipart-ctl-parameter
204 (narrow-to-region (point) (point))
206 (goto-char (point-min))
208 (if (looking-at "^-")
211 (unless (setq part (mm-find-part-by-type
212 (cdr handle) "application/pgp-signature" nil t))
213 (mm-set-handle-multipart-parameter
214 mm-security-handle 'gnus-info "Corrupted")
215 (throw 'error handle))
217 (narrow-to-region (point) (point))
218 (mm-insert-part part)
219 (goto-char (point-min))
220 (if (re-search-forward "^-----BEGIN PGP [^-]+-----\r?$" nil t)
221 (replace-match "-----BEGIN PGP SIGNATURE-----" t t))
222 (if (re-search-forward "^-----END PGP [^-]+-----\r?$" nil t)
223 (replace-match "-----END PGP SIGNATURE-----" t t)))
224 (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
225 (unless (condition-case err
227 (funcall mml2015-verify-function)
228 (if (get-buffer " *mailcrypt stderr temp")
229 (mm-set-handle-multipart-parameter
230 mm-security-handle 'gnus-details
231 (with-current-buffer " *mailcrypt stderr temp"
233 (if (get-buffer " *mailcrypt stdout temp")
234 (kill-buffer " *mailcrypt stdout temp"))
235 (if (get-buffer " *mailcrypt stderr temp")
236 (kill-buffer " *mailcrypt stderr temp"))
237 (if (get-buffer " *mailcrypt status temp")
238 (kill-buffer " *mailcrypt status temp"))
239 (if (get-buffer mc-gpg-debug-buffer)
240 (kill-buffer mc-gpg-debug-buffer)))
242 (mm-set-handle-multipart-parameter
243 mm-security-handle 'gnus-details (mml2015-format-error err))
246 (mm-set-handle-multipart-parameter
247 mm-security-handle 'gnus-details "Quit.")
249 (mm-set-handle-multipart-parameter
250 mm-security-handle 'gnus-info "Failed")
251 (throw 'error handle))))
252 (mm-set-handle-multipart-parameter
253 mm-security-handle 'gnus-info "OK")
256 (defun mml2015-mailcrypt-clear-verify ()
257 (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
258 (if (condition-case err
260 (funcall mml2015-verify-function)
261 (if (get-buffer " *mailcrypt stderr temp")
262 (mm-set-handle-multipart-parameter
263 mm-security-handle 'gnus-details
264 (with-current-buffer " *mailcrypt stderr temp"
266 (if (get-buffer " *mailcrypt stdout temp")
267 (kill-buffer " *mailcrypt stdout temp"))
268 (if (get-buffer " *mailcrypt stderr temp")
269 (kill-buffer " *mailcrypt stderr temp"))
270 (if (get-buffer " *mailcrypt status temp")
271 (kill-buffer " *mailcrypt status temp"))
272 (if (get-buffer mc-gpg-debug-buffer)
273 (kill-buffer mc-gpg-debug-buffer)))
275 (mm-set-handle-multipart-parameter
276 mm-security-handle 'gnus-details (mml2015-format-error err))
279 (mm-set-handle-multipart-parameter
280 mm-security-handle 'gnus-details "Quit.")
282 (mm-set-handle-multipart-parameter
283 mm-security-handle 'gnus-info "OK")
284 (mm-set-handle-multipart-parameter
285 mm-security-handle 'gnus-info "Failed"))))
287 (defun mml2015-mailcrypt-sign (cont)
288 (mc-sign-generic (message-options-get 'message-sender)
290 (let ((boundary (mml-compute-boundary cont))
292 (goto-char (point-min))
293 (unless (re-search-forward "^-----BEGIN PGP SIGNED MESSAGE-----\r?$" nil t)
294 (error "Cannot find signed begin line"))
295 (goto-char (match-beginning 0))
297 (unless (looking-at "Hash:[ \t]*\\([a-zA-Z0-9]+\\)")
298 (error "Cannot not find PGP hash"))
299 (setq hash (match-string 1))
300 (unless (re-search-forward "^$" nil t)
301 (error "Cannot not find PGP message"))
303 (delete-region (point-min) (point))
304 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
306 (insert (format "\tmicalg=pgp-%s; protocol=\"application/pgp-signature\"\n"
308 (insert (format "\n--%s\n" boundary))
310 (goto-char (point-max))
311 (unless (re-search-backward "^-----END PGP SIGNATURE-----\r?$" nil t)
312 (error "Cannot find signature part"))
313 (replace-match "-----END PGP MESSAGE-----" t t)
314 (goto-char (match-beginning 0))
315 (unless (re-search-backward "^-----BEGIN PGP SIGNATURE-----\r?$"
317 (error "Cannot find signature part"))
318 (replace-match "-----BEGIN PGP MESSAGE-----" t t)
319 (goto-char (match-beginning 0))
321 (narrow-to-region point (point))
323 (while (re-search-forward "^- -" nil t)
324 (replace-match "-" t t))
325 (goto-char (point-max)))
326 (insert (format "--%s\n" boundary))
327 (insert "Content-Type: application/pgp-signature\n\n")
328 (goto-char (point-max))
329 (insert (format "--%s--\n" boundary))
330 (goto-char (point-max))))
332 (defun mml2015-mailcrypt-encrypt (cont &optional sign)
333 (let ((mc-pgp-always-sign
334 (or mc-pgp-always-sign
336 (eq t (or (message-options-get 'message-sign-encrypt)
338 'message-sign-encrypt
339 (or (y-or-n-p "Sign the message? ")
342 (mm-with-unibyte-current-buffer
344 (or (message-options-get 'message-recipients)
345 (message-options-set 'message-recipients
346 (mc-cleanup-recipient-headers
347 (read-string "Recipients: "))))
349 (message-options-get 'message-sender))))
350 (goto-char (point-min))
351 (unless (looking-at "-----BEGIN PGP MESSAGE-----")
352 (error "Fail to encrypt the message"))
353 (let ((boundary (mml-compute-boundary cont)))
354 (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
356 (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
357 (insert (format "--%s\n" boundary))
358 (insert "Content-Type: application/pgp-encrypted\n\n")
359 (insert "Version: 1\n\n")
360 (insert (format "--%s\n" boundary))
361 (insert "Content-Type: application/octet-stream\n\n")
362 (goto-char (point-max))
363 (insert (format "--%s--\n" boundary))
364 (goto-char (point-max))))
369 (autoload 'gpg-decrypt "gpg")
370 (autoload 'gpg-verify "gpg")
371 (autoload 'gpg-verify-cleartext "gpg")
372 (autoload 'gpg-sign-detached "gpg")
373 (autoload 'gpg-sign-encrypt "gpg")
374 (autoload 'gpg-encrypt "gpg")
375 (autoload 'gpg-passphrase-read "gpg"))
377 (defun mml2015-gpg-passphrase ()
378 (or (message-options-get 'gpg-passphrase)
379 (message-options-set 'gpg-passphrase (gpg-passphrase-read))))
381 (defun mml2015-gpg-decrypt-1 ()
382 (let ((cipher (current-buffer)) plain result)
383 (if (with-temp-buffer
385 (gpg-decrypt cipher (setq plain (current-buffer))
386 mml2015-result-buffer nil)
387 (mm-set-handle-multipart-parameter
388 mm-security-handle 'gnus-details
389 (with-current-buffer mml2015-result-buffer
393 (insert-buffer-substring plain)
394 (goto-char (point-min))
395 (while (search-forward "\r\n" nil t)
396 (replace-match "\n" t t))))
398 ;; Some wrong with the return value, check plain text buffer.
399 (if (> (point-max) (point-min))
403 (defun mml2015-gpg-decrypt (handle ctl)
404 (let ((mml2015-decrypt-function 'mml2015-gpg-decrypt-1))
405 (mml2015-mailcrypt-decrypt handle ctl)))
407 (defun mml2015-gpg-clear-decrypt ()
409 (setq result (mml2015-gpg-decrypt-1))
411 (mm-set-handle-multipart-parameter
412 mm-security-handle 'gnus-info "OK")
413 (mm-set-handle-multipart-parameter
414 mm-security-handle 'gnus-info "Failed"))))
416 (defun mml2015-gpg-pretty-print-fpr (fingerprint)
418 (fpr-length (string-width fingerprint))
421 (setq fingerprint (string-to-list fingerprint))
423 (setq fpr-length (- fpr-length 4))
424 (setq slice (butlast fingerprint fpr-length))
425 (setq fingerprint (nthcdr 4 fingerprint))
426 (setq n-slice (1+ n-slice))
432 (otherwise (concat " " slice))))))
435 (defun mml2015-gpg-extract-signature-details ()
436 (goto-char (point-min))
437 (let* ((expired (re-search-forward
438 "^\\[GNUPG:\\] SIGEXPIRED$"
440 (signer (and (re-search-forward
441 "^\\[GNUPG:\\] GOODSIG \\([0-9A-Za-z]*\\) \\(.*\\)$"
443 (cons (match-string 1) (match-string 2))))
444 (fprint (and (re-search-forward
445 "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) "
448 (trust (and (re-search-forward
449 "^\\[GNUPG:\\] \\(TRUST_.*\\)$"
453 (cdr (assoc trust mml2015-unabbrev-trust-alist))))
454 (cond ((and signer fprint)
456 (unless trust-good-enough-p
457 (concat "\nUntrusted, Fingerprint: "
458 (mml2015-gpg-pretty-print-fpr fprint)))
460 (format "\nWARNING: Signature from expired key (%s)"
463 "^\\(gpg: \\)?Good signature from \"\\(.*\\)\"$" nil t)
466 "From unknown user"))))
468 (defun mml2015-gpg-verify (handle ctl)
470 (let (part message signature info-is-set-p)
471 (unless (setq part (mm-find-raw-part-by-type
472 ctl (or (mm-handle-multipart-ctl-parameter
474 "application/pgp-signature")
476 (mm-set-handle-multipart-parameter
477 mm-security-handle 'gnus-info "Corrupted")
478 (throw 'error handle))
480 (setq message (current-buffer))
482 ;; Convert <LF> to <CR><LF> in verify mode. Sign and
483 ;; clearsign use --textmode. The conversion is not necessary.
484 ;; In clearverify, the conversion is not necessary either.
485 (goto-char (point-min))
488 (unless (eq (char-before) ?\r)
493 (setq signature (current-buffer))
494 (unless (setq part (mm-find-part-by-type
495 (cdr handle) "application/pgp-signature" nil t))
496 (mm-set-handle-multipart-parameter
497 mm-security-handle 'gnus-info "Corrupted")
498 (throw 'error handle))
499 (mm-insert-part part)
500 (unless (condition-case err
502 (gpg-verify message signature mml2015-result-buffer)
503 (mm-set-handle-multipart-parameter
504 mm-security-handle 'gnus-details
505 (with-current-buffer mml2015-result-buffer
508 (mm-set-handle-multipart-parameter
509 mm-security-handle 'gnus-details (mml2015-format-error err))
510 (mm-set-handle-multipart-parameter
511 mm-security-handle 'gnus-info "Error.")
512 (setq info-is-set-p t)
515 (mm-set-handle-multipart-parameter
516 mm-security-handle 'gnus-details "Quit.")
517 (mm-set-handle-multipart-parameter
518 mm-security-handle 'gnus-info "Quit.")
519 (setq info-is-set-p t)
521 (unless info-is-set-p
522 (mm-set-handle-multipart-parameter
523 mm-security-handle 'gnus-info "Failed"))
524 (throw 'error handle)))
525 (mm-set-handle-multipart-parameter
526 mm-security-handle 'gnus-info
527 (with-current-buffer mml2015-result-buffer
528 (mml2015-gpg-extract-signature-details))))
531 (defun mml2015-gpg-clear-verify ()
532 (if (condition-case err
534 (gpg-verify-cleartext (current-buffer) mml2015-result-buffer)
535 (mm-set-handle-multipart-parameter
536 mm-security-handle 'gnus-details
537 (with-current-buffer mml2015-result-buffer
540 (mm-set-handle-multipart-parameter
541 mm-security-handle 'gnus-details (mml2015-format-error err))
544 (mm-set-handle-multipart-parameter
545 mm-security-handle 'gnus-details "Quit.")
547 (mm-set-handle-multipart-parameter
548 mm-security-handle 'gnus-info
549 (with-current-buffer mml2015-result-buffer
550 (mml2015-gpg-extract-signature-details)))
551 (mm-set-handle-multipart-parameter
552 mm-security-handle 'gnus-info "Failed")))
554 (defun mml2015-gpg-sign (cont)
555 (let ((boundary (mml-compute-boundary cont))
556 (text (current-buffer)) signature)
557 (goto-char (point-max))
561 (unless (gpg-sign-detached text (setq signature (current-buffer))
562 mml2015-result-buffer
564 (message-options-get 'message-sender)
565 t t) ; armor & textmode
566 (unless (> (point-max) (point-min))
567 (pop-to-buffer mml2015-result-buffer)
568 (error "Sign error")))
569 (goto-char (point-min))
570 (while (re-search-forward "\r+$" nil t)
571 (replace-match "" t t))
573 (goto-char (point-min))
574 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
576 ;;; FIXME: what is the micalg?
577 (insert "\tmicalg=pgp-sha1; protocol=\"application/pgp-signature\"\n")
578 (insert (format "\n--%s\n" boundary))
579 (goto-char (point-max))
580 (insert (format "\n--%s\n" boundary))
581 (insert "Content-Type: application/pgp-signature\n\n")
582 (insert-buffer-substring signature)
583 (goto-char (point-max))
584 (insert (format "--%s--\n" boundary))
585 (goto-char (point-max)))))
587 (defun mml2015-gpg-encrypt (cont &optional sign)
588 (let ((boundary (mml-compute-boundary cont))
589 (text (current-buffer))
591 (mm-with-unibyte-current-buffer
593 ;; set up a function to call the correct gpg encrypt routine
594 ;; with the right arguments. (FIXME: this should be done
596 (flet ((gpg-encrypt-func
597 (sign plaintext ciphertext result recipients &optional
598 passphrase sign-with-key armor textmode)
601 plaintext ciphertext result recipients passphrase
602 sign-with-key armor textmode)
604 plaintext ciphertext result recipients passphrase
606 (unless (gpg-encrypt-func
607 sign ; passed in when using signencrypt
608 text (setq cipher (current-buffer))
609 mml2015-result-buffer
612 (message-options-get 'message-recipients)
613 (message-options-set 'message-recipients
614 (read-string "Recipients: ")))
617 (message-options-get 'message-sender)
618 t t) ; armor & textmode
619 (unless (> (point-max) (point-min))
620 (pop-to-buffer mml2015-result-buffer)
621 (error "Encrypt error"))))
622 (goto-char (point-min))
623 (while (re-search-forward "\r+$" nil t)
624 (replace-match "" t t))
626 (delete-region (point-min) (point-max))
627 (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
629 (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
630 (insert (format "--%s\n" boundary))
631 (insert "Content-Type: application/pgp-encrypted\n\n")
632 (insert "Version: 1\n\n")
633 (insert (format "--%s\n" boundary))
634 (insert "Content-Type: application/octet-stream\n\n")
635 (insert-buffer-substring cipher)
636 (goto-char (point-max))
637 (insert (format "--%s--\n" boundary))
638 (goto-char (point-max))))))
643 (defvar pgg-default-user-id)
644 (defvar pgg-errors-buffer)
645 (defvar pgg-output-buffer))
648 (autoload 'pgg-decrypt-region "pgg")
649 (autoload 'pgg-verify-region "pgg")
650 (autoload 'pgg-sign-region "pgg")
651 (autoload 'pgg-encrypt-region "pgg")
652 (autoload 'pgg-parse-armor "pgg-parse"))
654 (defun mml2015-pgg-decrypt (handle ctl)
656 (let ((pgg-errors-buffer mml2015-result-buffer)
657 child handles result decrypt-status)
658 (unless (setq child (mm-find-part-by-type
660 "application/octet-stream" nil t))
661 (mm-set-handle-multipart-parameter
662 mm-security-handle 'gnus-info "Corrupted")
663 (throw 'error handle))
665 (mm-insert-part child)
666 (if (condition-case err
668 (pgg-decrypt-region (point-min) (point-max))
670 (with-current-buffer mml2015-result-buffer
672 (mm-set-handle-multipart-parameter
673 mm-security-handle 'gnus-details
676 (mm-set-handle-multipart-parameter
677 mm-security-handle 'gnus-details (mml2015-format-error err))
680 (mm-set-handle-multipart-parameter
681 mm-security-handle 'gnus-details "Quit.")
683 (with-current-buffer pgg-output-buffer
684 (goto-char (point-min))
685 (while (search-forward "\r\n" nil t)
686 (replace-match "\n" t t))
687 (setq handles (mm-dissect-buffer t))
688 (mm-destroy-parts handle)
689 (mm-set-handle-multipart-parameter
690 mm-security-handle 'gnus-info "OK")
691 (mm-set-handle-multipart-parameter
692 mm-security-handle 'gnus-details
693 (concat decrypt-status
694 (when (stringp (car handles))
695 "\n" (mm-handle-multipart-ctl-parameter
696 handles 'gnus-details))))
697 (if (listp (car handles))
700 (mm-set-handle-multipart-parameter
701 mm-security-handle 'gnus-info "Failed")
702 (throw 'error handle))))))
704 (defun mml2015-pgg-clear-decrypt ()
705 (let ((pgg-errors-buffer mml2015-result-buffer))
707 (pgg-decrypt-region (point-min) (point-max))
708 (mm-set-handle-multipart-parameter
709 mm-security-handle 'gnus-details
710 (with-current-buffer mml2015-result-buffer
714 (insert-buffer-substring pgg-output-buffer)
715 (goto-char (point-min))
716 (while (search-forward "\r\n" nil t)
717 (replace-match "\n" t t))
718 (mm-set-handle-multipart-parameter
719 mm-security-handle 'gnus-info "OK"))
720 (mm-set-handle-multipart-parameter
721 mm-security-handle 'gnus-info "Failed"))))
723 (defun mml2015-pgg-verify (handle ctl)
724 (let ((pgg-errors-buffer mml2015-result-buffer)
725 signature-file part signature)
726 (if (or (null (setq part (mm-find-raw-part-by-type
727 ctl (or (mm-handle-multipart-ctl-parameter
729 "application/pgp-signature")
731 (null (setq signature (mm-find-part-by-type
732 (cdr handle) "application/pgp-signature" nil t))))
734 (mm-set-handle-multipart-parameter
735 mm-security-handle 'gnus-info "Corrupted")
739 ;; Convert <LF> to <CR><LF> in verify mode. Sign and
740 ;; clearsign use --textmode. The conversion is not necessary.
741 ;; In clearverify, the conversion is not necessary either.
742 (goto-char (point-min))
745 (unless (eq (char-before) ?\r)
749 (with-temp-file (setq signature-file (mm-make-temp-file "pgg"))
750 (mm-insert-part signature))
751 (if (condition-case err
753 (pgg-verify-region (point-min) (point-max)
755 (goto-char (point-min))
756 (while (search-forward "\r\n" nil t)
757 (replace-match "\n" t t))
758 (mm-set-handle-multipart-parameter
759 mm-security-handle 'gnus-details
760 (concat (with-current-buffer pgg-output-buffer
762 (with-current-buffer pgg-errors-buffer
765 (mm-set-handle-multipart-parameter
766 mm-security-handle 'gnus-details (mml2015-format-error err))
769 (mm-set-handle-multipart-parameter
770 mm-security-handle 'gnus-details "Quit.")
773 (delete-file signature-file)
774 (mm-set-handle-multipart-parameter
775 mm-security-handle 'gnus-info
776 (with-current-buffer pgg-errors-buffer
777 (mml2015-gpg-extract-signature-details))))
778 (delete-file signature-file)
779 (mm-set-handle-multipart-parameter
780 mm-security-handle 'gnus-info "Failed")))))
783 (defun mml2015-pgg-clear-verify ()
784 (let ((pgg-errors-buffer mml2015-result-buffer)
785 (text (buffer-string))
786 (coding-system buffer-file-coding-system))
787 (if (condition-case err
789 (mm-with-unibyte-buffer
790 (insert (encode-coding-string text coding-system))
791 (pgg-verify-region (point-min) (point-max) nil t))
792 (goto-char (point-min))
793 (while (search-forward "\r\n" nil t)
794 (replace-match "\n" t t))
795 (mm-set-handle-multipart-parameter
796 mm-security-handle 'gnus-details
797 (concat (with-current-buffer pgg-output-buffer
799 (with-current-buffer pgg-errors-buffer
802 (mm-set-handle-multipart-parameter
803 mm-security-handle 'gnus-details (mml2015-format-error err))
806 (mm-set-handle-multipart-parameter
807 mm-security-handle 'gnus-details "Quit.")
809 (mm-set-handle-multipart-parameter
810 mm-security-handle 'gnus-info
811 (with-current-buffer pgg-errors-buffer
812 (mml2015-gpg-extract-signature-details)))
813 (mm-set-handle-multipart-parameter
814 mm-security-handle 'gnus-info "Failed"))))
816 (defun mml2015-pgg-sign (cont)
817 (let ((pgg-errors-buffer mml2015-result-buffer)
818 (boundary (mml-compute-boundary cont))
819 (pgg-default-user-id (or (message-options-get 'mml-sender)
820 pgg-default-user-id))
822 (unless (pgg-sign-region (point-min) (point-max))
823 (pop-to-buffer mml2015-result-buffer)
824 (error "Sign error"))
825 (goto-char (point-min))
826 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
828 (if (setq entry (assq 2 (pgg-parse-armor
829 (with-current-buffer pgg-output-buffer
831 (setq entry (assq 'hash-algorithm (cdr entry))))
832 (insert (format "\tmicalg=%s; "
834 (downcase (format "pgp-%s" (cdr entry)))
836 (insert "protocol=\"application/pgp-signature\"\n")
837 (insert (format "\n--%s\n" boundary))
838 (goto-char (point-max))
839 (insert (format "\n--%s\n" boundary))
840 (insert "Content-Type: application/pgp-signature\n\n")
841 (insert-buffer-substring pgg-output-buffer)
842 (goto-char (point-max))
843 (insert (format "--%s--\n" boundary))
844 (goto-char (point-max))))
846 (defun mml2015-pgg-encrypt (cont &optional sign)
847 (let ((pgg-errors-buffer mml2015-result-buffer)
848 (boundary (mml-compute-boundary cont)))
849 (unless (pgg-encrypt-region (point-min) (point-max)
852 (message-options-get 'message-recipients)
853 (message-options-set 'message-recipients
854 (read-string "Recipients: ")))
857 (pop-to-buffer mml2015-result-buffer)
858 (error "Encrypt error"))
859 (delete-region (point-min) (point-max))
860 (goto-char (point-min))
861 (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
863 (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
864 (insert (format "--%s\n" boundary))
865 (insert "Content-Type: application/pgp-encrypted\n\n")
866 (insert "Version: 1\n\n")
867 (insert (format "--%s\n" boundary))
868 (insert "Content-Type: application/octet-stream\n\n")
869 (insert-buffer-substring pgg-output-buffer)
870 (goto-char (point-max))
871 (insert (format "--%s--\n" boundary))
872 (goto-char (point-max))))
876 (defun mml2015-clean-buffer ()
877 (if (gnus-buffer-live-p mml2015-result-buffer)
878 (with-current-buffer mml2015-result-buffer
881 (setq mml2015-result-buffer
882 (gnus-get-buffer-create " *MML2015 Result*"))
885 (defsubst mml2015-clear-decrypt-function ()
886 (nth 6 (assq mml2015-use mml2015-function-alist)))
888 (defsubst mml2015-clear-verify-function ()
889 (nth 5 (assq mml2015-use mml2015-function-alist)))
892 (defun mml2015-decrypt (handle ctl)
893 (mml2015-clean-buffer)
894 (let ((func (nth 4 (assq mml2015-use mml2015-function-alist))))
896 (funcall func handle ctl)
900 (defun mml2015-decrypt-test (handle ctl)
904 (defun mml2015-verify (handle ctl)
905 (mml2015-clean-buffer)
906 (let ((func (nth 3 (assq mml2015-use mml2015-function-alist))))
908 (funcall func handle ctl)
912 (defun mml2015-verify-test (handle ctl)
916 (defun mml2015-encrypt (cont &optional sign)
917 (mml2015-clean-buffer)
918 (let ((func (nth 2 (assq mml2015-use mml2015-function-alist))))
920 (funcall func cont sign)
921 (error "Cannot find encrypt function"))))
924 (defun mml2015-sign (cont)
925 (mml2015-clean-buffer)
926 (let ((func (nth 1 (assq mml2015-use mml2015-function-alist))))
929 (error "Cannot find sign function"))))
932 (defun mml2015-self-encrypt ()
933 (mml2015-encrypt nil))
937 ;;; mml2015.el ends here