1 ;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP)
3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006, 2007 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
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.")
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-default-user-id
)
640 (defvar pgg-errors-buffer
)
641 (defvar pgg-output-buffer
))
644 (autoload 'pgg-decrypt-region
"pgg")
645 (autoload 'pgg-verify-region
"pgg")
646 (autoload 'pgg-sign-region
"pgg")
647 (autoload 'pgg-encrypt-region
"pgg")
648 (autoload 'pgg-parse-armor
"pgg-parse"))
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 ;; Treat data which pgg returns as a unibyte string.
711 (mm-disable-multibyte)
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 (mm-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
))
821 (unless (pgg-sign-region (point-min) (point-max))
822 (pop-to-buffer mml2015-result-buffer
)
823 (error "Sign error"))
824 (goto-char (point-min))
825 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
827 (if (setq entry
(assq 2 (pgg-parse-armor
828 (with-current-buffer pgg-output-buffer
830 (setq entry
(assq 'hash-algorithm
(cdr entry
))))
831 (insert (format "\tmicalg=%s; "
833 (downcase (format "pgp-%s" (cdr entry
)))
835 (insert "protocol=\"application/pgp-signature\"\n")
836 (insert (format "\n--%s\n" boundary
))
837 (goto-char (point-max))
838 (insert (format "\n--%s\n" boundary
))
839 (insert "Content-Type: application/pgp-signature\n\n")
840 (insert-buffer-substring pgg-output-buffer
)
841 (goto-char (point-max))
842 (insert (format "--%s--\n" boundary
))
843 (goto-char (point-max))))
845 (defun mml2015-pgg-encrypt (cont &optional sign
)
846 (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 ;;; arch-tag: b04701d5-0b09-44d8-bed8-de901bf435f2
938 ;;; mml2015.el ends here