f08fa1421a5587d796309aefa6b1be02cba80843
[gnus] / lisp / mml2015.el
1 ;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP)
2
3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
4 ;;   2005, 2006 Free Software Foundation, Inc.
5
6 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
7 ;; Keywords: PGP MIME MML
8
9 ;; This file is part of GNU Emacs.
10
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.
15
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.
20
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.
25
26 ;;; Commentary:
27
28 ;; RFC 2015 is updated by RFC 3156, this file should be compatible
29 ;; with both.
30
31 ;;; Code:
32
33 (eval-when-compile (require 'cl))
34 (require 'mm-decode)
35 (require 'mm-util)
36 (require 'mml)
37 (require 'mml-sec)
38
39 (defvar mc-pgp-always-sign)
40
41 (defvar mml2015-use (or
42                      (progn
43                        (ignore-errors
44                         ;; Avoid the "Recursive load suspected" error
45                         ;; in Emacs 21.1.
46                         (let ((recursive-load-depth-limit 100))
47                           (require 'pgg)))
48                        (and (fboundp 'pgg-sign-region)
49                             'pgg))
50                      (progn
51                        (ignore-errors
52                          (require 'gpg))
53                        (and (fboundp 'gpg-sign-detached)
54                             'gpg))
55                      (progn (ignore-errors
56                               (load "mc-toplev"))
57                             (and (fboundp 'mc-encrypt-generic)
58                                  (fboundp 'mc-sign-generic)
59                                  (fboundp 'mc-cleanup-recipient-headers)
60                                  'mailcrypt)))
61   "The package used for PGP/MIME.
62 Valid packages include `pgg', `gpg' and `mailcrypt'.")
63
64 ;; Something is not RFC2015.
65 (defvar mml2015-function-alist
66   '((mailcrypt mml2015-mailcrypt-sign
67                mml2015-mailcrypt-encrypt
68                mml2015-mailcrypt-verify
69                mml2015-mailcrypt-decrypt
70                mml2015-mailcrypt-clear-verify
71                mml2015-mailcrypt-clear-decrypt)
72     (gpg mml2015-gpg-sign
73          mml2015-gpg-encrypt
74          mml2015-gpg-verify
75          mml2015-gpg-decrypt
76          mml2015-gpg-clear-verify
77          mml2015-gpg-clear-decrypt)
78   (pgg mml2015-pgg-sign
79        mml2015-pgg-encrypt
80        mml2015-pgg-verify
81        mml2015-pgg-decrypt
82        mml2015-pgg-clear-verify
83        mml2015-pgg-clear-decrypt)
84   (epg mml2015-epg-sign
85        mml2015-epg-encrypt
86        mml2015-epg-verify
87        mml2015-epg-decrypt
88        mml2015-epg-clear-verify
89        mml2015-epg-clear-decrypt))
90   "Alist of PGP/MIME functions.")
91
92 (defvar mml2015-result-buffer nil)
93
94 (defcustom mml2015-unabbrev-trust-alist
95   '(("TRUST_UNDEFINED" . nil)
96     ("TRUST_NEVER"     . nil)
97     ("TRUST_MARGINAL"  . t)
98     ("TRUST_FULLY"     . t)
99     ("TRUST_ULTIMATE"  . t))
100   "Map GnuPG trust output values to a boolean saying if you trust the key."
101   :version "22.1"
102   :group 'mime-security
103   :type '(repeat (cons (regexp :tag "GnuPG output regexp")
104                        (boolean :tag "Trust key"))))
105
106 (defcustom mml2015-verbose mml-secure-verbose
107   "If non-nil, ask the user about the current operation more verbosely."
108   :group 'mime-security
109   :type 'boolean)
110
111 (defcustom mml2015-cache-passphrase mml-secure-cache-passphrase
112   "If t, cache passphrase."
113   :group 'mime-security
114   :type 'boolean)
115
116 (defcustom mml2015-passphrase-cache-expiry mml-secure-passphrase-cache-expiry
117   "How many seconds the passphrase is cached.
118 Whether the passphrase is cached at all is controlled by
119 `mml2015-cache-passphrase'."
120   :group 'mime-security
121   :type 'integer)
122
123 (defcustom mml2015-signers nil
124   "A list of your own key ID which will be used to sign a message."
125   :group 'mime-security
126   :type '(repeat (string :tag "Key ID")))
127
128 (defcustom mml2015-encrypt-to-self nil
129   "If t, add your own key ID to recipient list when encryption."
130   :group 'mime-security
131   :type 'boolean)
132
133 ;;; mailcrypt wrapper
134
135 (eval-and-compile
136   (autoload 'mailcrypt-decrypt "mailcrypt")
137   (autoload 'mailcrypt-verify "mailcrypt")
138   (autoload 'mc-pgp-always-sign "mailcrypt")
139   (autoload 'mc-encrypt-generic "mc-toplev")
140   (autoload 'mc-cleanup-recipient-headers "mc-toplev")
141   (autoload 'mc-sign-generic "mc-toplev"))
142
143 (eval-when-compile
144   (defvar mc-default-scheme)
145   (defvar mc-schemes))
146
147 (defvar mml2015-decrypt-function 'mailcrypt-decrypt)
148 (defvar mml2015-verify-function 'mailcrypt-verify)
149
150 (defun mml2015-format-error (err)
151   (if (stringp (cadr err))
152       (cadr err)
153     (format "%S" (cdr err))))
154
155 (defun mml2015-mailcrypt-decrypt (handle ctl)
156   (catch 'error
157     (let (child handles result)
158       (unless (setq child (mm-find-part-by-type
159                            (cdr handle)
160                            "application/octet-stream" nil t))
161         (mm-set-handle-multipart-parameter
162          mm-security-handle 'gnus-info "Corrupted")
163         (throw 'error handle))
164       (with-temp-buffer
165         (mm-insert-part child)
166         (setq result
167               (condition-case err
168                   (funcall mml2015-decrypt-function)
169                 (error
170                  (mm-set-handle-multipart-parameter
171                   mm-security-handle 'gnus-details (mml2015-format-error err))
172                  nil)
173                 (quit
174                  (mm-set-handle-multipart-parameter
175                   mm-security-handle 'gnus-details "Quit.")
176                  nil)))
177         (unless (car result)
178           (mm-set-handle-multipart-parameter
179            mm-security-handle 'gnus-info "Failed")
180           (throw 'error handle))
181         (setq handles (mm-dissect-buffer t)))
182       (mm-destroy-parts handle)
183       (mm-set-handle-multipart-parameter
184        mm-security-handle 'gnus-info
185        (concat "OK"
186                (let ((sig (with-current-buffer mml2015-result-buffer
187                             (mml2015-gpg-extract-signature-details))))
188                  (concat ", Signer: " sig))))
189       (if (listp (car handles))
190           handles
191         (list handles)))))
192
193 (defun mml2015-mailcrypt-clear-decrypt ()
194   (let (result)
195     (setq result
196           (condition-case err
197               (funcall mml2015-decrypt-function)
198             (error
199              (mm-set-handle-multipart-parameter
200               mm-security-handle 'gnus-details (mml2015-format-error err))
201              nil)
202             (quit
203              (mm-set-handle-multipart-parameter
204               mm-security-handle 'gnus-details "Quit.")
205              nil)))
206     (if (car result)
207         (mm-set-handle-multipart-parameter
208          mm-security-handle 'gnus-info "OK")
209       (mm-set-handle-multipart-parameter
210        mm-security-handle 'gnus-info "Failed"))))
211
212 (defun mml2015-fix-micalg (alg)
213   (and alg
214        ;; Mutt/1.2.5i has seen sending micalg=php-sha1
215        (upcase (if (string-match "^p[gh]p-" alg)
216                    (substring alg (match-end 0))
217                  alg))))
218
219 (defun mml2015-mailcrypt-verify (handle ctl)
220   (catch 'error
221     (let (part)
222       (unless (setq part (mm-find-raw-part-by-type
223                           ctl (or (mm-handle-multipart-ctl-parameter
224                                    ctl 'protocol)
225                                   "application/pgp-signature")
226                           t))
227         (mm-set-handle-multipart-parameter
228          mm-security-handle 'gnus-info "Corrupted")
229         (throw 'error handle))
230       (with-temp-buffer
231         (insert "-----BEGIN PGP SIGNED MESSAGE-----\n")
232         (insert (format "Hash: %s\n\n"
233                         (or (mml2015-fix-micalg
234                              (mm-handle-multipart-ctl-parameter
235                               ctl 'micalg))
236                             "SHA1")))
237         (save-restriction
238           (narrow-to-region (point) (point))
239           (insert part "\n")
240           (goto-char (point-min))
241           (while (not (eobp))
242             (if (looking-at "^-")
243                 (insert "- "))
244             (forward-line)))
245         (unless (setq part (mm-find-part-by-type
246                             (cdr handle) "application/pgp-signature" nil t))
247           (mm-set-handle-multipart-parameter
248            mm-security-handle 'gnus-info "Corrupted")
249           (throw 'error handle))
250         (save-restriction
251           (narrow-to-region (point) (point))
252           (mm-insert-part part)
253           (goto-char (point-min))
254           (if (re-search-forward "^-----BEGIN PGP [^-]+-----\r?$" nil t)
255               (replace-match "-----BEGIN PGP SIGNATURE-----" t t))
256           (if (re-search-forward "^-----END PGP [^-]+-----\r?$" nil t)
257               (replace-match "-----END PGP SIGNATURE-----" t t)))
258         (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
259           (unless (condition-case err
260                       (prog1
261                           (funcall mml2015-verify-function)
262                         (if (get-buffer " *mailcrypt stderr temp")
263                             (mm-set-handle-multipart-parameter
264                              mm-security-handle 'gnus-details
265                              (with-current-buffer " *mailcrypt stderr temp"
266                                (buffer-string))))
267                         (if (get-buffer " *mailcrypt stdout temp")
268                             (kill-buffer " *mailcrypt stdout temp"))
269                         (if (get-buffer " *mailcrypt stderr temp")
270                             (kill-buffer " *mailcrypt stderr temp"))
271                         (if (get-buffer " *mailcrypt status temp")
272                             (kill-buffer " *mailcrypt status temp"))
273                         (if (get-buffer mc-gpg-debug-buffer)
274                             (kill-buffer mc-gpg-debug-buffer)))
275                     (error
276                      (mm-set-handle-multipart-parameter
277                       mm-security-handle 'gnus-details (mml2015-format-error err))
278                      nil)
279                     (quit
280                      (mm-set-handle-multipart-parameter
281                       mm-security-handle 'gnus-details "Quit.")
282                      nil))
283             (mm-set-handle-multipart-parameter
284              mm-security-handle 'gnus-info "Failed")
285             (throw 'error handle))))
286       (mm-set-handle-multipart-parameter
287        mm-security-handle 'gnus-info "OK")
288       handle)))
289
290 (defun mml2015-mailcrypt-clear-verify ()
291   (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
292     (if (condition-case err
293             (prog1
294                 (funcall mml2015-verify-function)
295               (if (get-buffer " *mailcrypt stderr temp")
296                   (mm-set-handle-multipart-parameter
297                    mm-security-handle 'gnus-details
298                    (with-current-buffer " *mailcrypt stderr temp"
299                      (buffer-string))))
300               (if (get-buffer " *mailcrypt stdout temp")
301                   (kill-buffer " *mailcrypt stdout temp"))
302               (if (get-buffer " *mailcrypt stderr temp")
303                   (kill-buffer " *mailcrypt stderr temp"))
304               (if (get-buffer " *mailcrypt status temp")
305                   (kill-buffer " *mailcrypt status temp"))
306               (if (get-buffer mc-gpg-debug-buffer)
307                   (kill-buffer mc-gpg-debug-buffer)))
308           (error
309            (mm-set-handle-multipart-parameter
310             mm-security-handle 'gnus-details (mml2015-format-error err))
311            nil)
312           (quit
313            (mm-set-handle-multipart-parameter
314             mm-security-handle 'gnus-details "Quit.")
315            nil))
316         (mm-set-handle-multipart-parameter
317          mm-security-handle 'gnus-info "OK")
318       (mm-set-handle-multipart-parameter
319        mm-security-handle 'gnus-info "Failed"))))
320
321 (defun mml2015-mailcrypt-sign (cont)
322   (mc-sign-generic (message-options-get 'message-sender)
323                    nil nil nil nil)
324   (let ((boundary (mml-compute-boundary cont))
325         hash point)
326     (goto-char (point-min))
327     (unless (re-search-forward "^-----BEGIN PGP SIGNED MESSAGE-----\r?$" nil t)
328       (error "Cannot find signed begin line"))
329     (goto-char (match-beginning 0))
330     (forward-line 1)
331     (unless (looking-at "Hash:[ \t]*\\([a-zA-Z0-9]+\\)")
332       (error "Cannot not find PGP hash"))
333     (setq hash (match-string 1))
334     (unless (re-search-forward "^$" nil t)
335       (error "Cannot not find PGP message"))
336     (forward-line 1)
337     (delete-region (point-min) (point))
338     (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
339                     boundary))
340     (insert (format "\tmicalg=pgp-%s; protocol=\"application/pgp-signature\"\n"
341                     (downcase hash)))
342     (insert (format "\n--%s\n" boundary))
343     (setq point (point))
344     (goto-char (point-max))
345     (unless (re-search-backward "^-----END PGP SIGNATURE-----\r?$" nil t)
346       (error "Cannot find signature part"))
347     (replace-match "-----END PGP MESSAGE-----" t t)
348     (goto-char (match-beginning 0))
349     (unless (re-search-backward "^-----BEGIN PGP SIGNATURE-----\r?$"
350                                 nil t)
351       (error "Cannot find signature part"))
352     (replace-match "-----BEGIN PGP MESSAGE-----" t t)
353     (goto-char (match-beginning 0))
354     (save-restriction
355       (narrow-to-region point (point))
356       (goto-char point)
357       (while (re-search-forward "^- -" nil t)
358         (replace-match "-" t t))
359       (goto-char (point-max)))
360     (insert (format "--%s\n" boundary))
361     (insert "Content-Type: application/pgp-signature\n\n")
362     (goto-char (point-max))
363     (insert (format "--%s--\n" boundary))
364     (goto-char (point-max))))
365
366 (defun mml2015-mailcrypt-encrypt (cont &optional sign)
367   (let ((mc-pgp-always-sign
368          (or mc-pgp-always-sign
369              sign
370              (eq t (or (message-options-get 'message-sign-encrypt)
371                        (message-options-set
372                         'message-sign-encrypt
373                         (or (y-or-n-p "Sign the message? ")
374                             'not))))
375              'never)))
376     (mm-with-unibyte-current-buffer
377       (mc-encrypt-generic
378        (or (message-options-get 'message-recipients)
379            (message-options-set 'message-recipients
380                               (mc-cleanup-recipient-headers
381                                (read-string "Recipients: "))))
382        nil nil nil
383        (message-options-get 'message-sender))))
384   (goto-char (point-min))
385   (unless (looking-at "-----BEGIN PGP MESSAGE-----")
386     (error "Fail to encrypt the message"))
387   (let ((boundary (mml-compute-boundary cont)))
388     (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
389                     boundary))
390     (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
391     (insert (format "--%s\n" boundary))
392     (insert "Content-Type: application/pgp-encrypted\n\n")
393     (insert "Version: 1\n\n")
394     (insert (format "--%s\n" boundary))
395     (insert "Content-Type: application/octet-stream\n\n")
396     (goto-char (point-max))
397     (insert (format "--%s--\n" boundary))
398     (goto-char (point-max))))
399
400 ;;; gpg wrapper
401
402 (eval-and-compile
403   (autoload 'gpg-decrypt "gpg")
404   (autoload 'gpg-verify "gpg")
405   (autoload 'gpg-verify-cleartext "gpg")
406   (autoload 'gpg-sign-detached "gpg")
407   (autoload 'gpg-sign-encrypt "gpg")
408   (autoload 'gpg-encrypt "gpg")
409   (autoload 'gpg-passphrase-read "gpg"))
410
411 (defun mml2015-gpg-passphrase ()
412   (or (message-options-get 'gpg-passphrase)
413       (message-options-set 'gpg-passphrase (gpg-passphrase-read))))
414
415 (defun mml2015-gpg-decrypt-1 ()
416   (let ((cipher (current-buffer)) plain result)
417     (if (with-temp-buffer
418           (prog1
419               (gpg-decrypt cipher (setq plain (current-buffer))
420                            mml2015-result-buffer nil)
421             (mm-set-handle-multipart-parameter
422              mm-security-handle 'gnus-details
423              (with-current-buffer mml2015-result-buffer
424                (buffer-string)))
425             (set-buffer cipher)
426             (erase-buffer)
427             (insert-buffer-substring plain)
428             (goto-char (point-min))
429             (while (search-forward "\r\n" nil t)
430               (replace-match "\n" t t))))
431         '(t)
432       ;; Some wrong with the return value, check plain text buffer.
433       (if (> (point-max) (point-min))
434           '(t)
435         nil))))
436
437 (defun mml2015-gpg-decrypt (handle ctl)
438   (let ((mml2015-decrypt-function 'mml2015-gpg-decrypt-1))
439     (mml2015-mailcrypt-decrypt handle ctl)))
440
441 (defun mml2015-gpg-clear-decrypt ()
442   (let (result)
443     (setq result (mml2015-gpg-decrypt-1))
444     (if (car result)
445         (mm-set-handle-multipart-parameter
446          mm-security-handle 'gnus-info "OK")
447       (mm-set-handle-multipart-parameter
448        mm-security-handle 'gnus-info "Failed"))))
449
450 (defun mml2015-gpg-pretty-print-fpr (fingerprint)
451   (let* ((result "")
452          (fpr-length (string-width fingerprint))
453          (n-slice 0)
454          slice)
455     (setq fingerprint (string-to-list fingerprint))
456     (while fingerprint
457       (setq fpr-length (- fpr-length 4))
458       (setq slice (butlast fingerprint fpr-length))
459       (setq fingerprint (nthcdr 4 fingerprint))
460       (setq n-slice (1+ n-slice))
461       (setq result
462             (concat
463              result
464              (case n-slice
465                (1  slice)
466                (otherwise (concat " " slice))))))
467     result))
468
469 (defun mml2015-gpg-extract-signature-details ()
470   (goto-char (point-min))
471   (let* ((expired (re-search-forward
472                    "^\\[GNUPG:\\] SIGEXPIRED$"
473                    nil t))
474          (signer (and (re-search-forward
475                        "^\\[GNUPG:\\] GOODSIG \\([0-9A-Za-z]*\\) \\(.*\\)$"
476                        nil t)
477                       (cons (match-string 1) (match-string 2))))
478          (fprint (and (re-search-forward
479                        "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) "
480                        nil t)
481                       (match-string 1)))
482          (trust  (and (re-search-forward
483                        "^\\[GNUPG:\\] \\(TRUST_.*\\)$"
484                        nil t)
485                       (match-string 1)))
486          (trust-good-enough-p
487           (cdr (assoc trust mml2015-unabbrev-trust-alist))))
488     (cond ((and signer fprint)
489            (concat (cdr signer)
490                    (unless trust-good-enough-p
491                      (concat "\nUntrusted, Fingerprint: "
492                              (mml2015-gpg-pretty-print-fpr fprint)))
493                    (when expired
494                      (format "\nWARNING: Signature from expired key (%s)"
495                              (car signer)))))
496           ((re-search-forward
497             "^\\(gpg: \\)?Good signature from \"\\(.*\\)\"$" nil t)
498            (match-string 2))
499           (t
500            "From unknown user"))))
501
502 (defun mml2015-gpg-verify (handle ctl)
503   (catch 'error
504     (let (part message signature info-is-set-p)
505       (unless (setq part (mm-find-raw-part-by-type
506                           ctl (or (mm-handle-multipart-ctl-parameter
507                                    ctl 'protocol)
508                                   "application/pgp-signature")
509                           t))
510         (mm-set-handle-multipart-parameter
511          mm-security-handle 'gnus-info "Corrupted")
512         (throw 'error handle))
513       (with-temp-buffer
514         (setq message (current-buffer))
515         (insert part)
516         ;; Convert <LF> to <CR><LF> in verify mode.  Sign and
517         ;; clearsign use --textmode. The conversion is not necessary.
518         ;; In clearverify, the conversion is not necessary either.
519         (goto-char (point-min))
520         (end-of-line)
521         (while (not (eobp))
522           (unless (eq (char-before) ?\r)
523             (insert "\r"))
524           (forward-line)
525           (end-of-line))
526         (with-temp-buffer
527           (setq signature (current-buffer))
528           (unless (setq part (mm-find-part-by-type
529                               (cdr handle) "application/pgp-signature" nil t))
530             (mm-set-handle-multipart-parameter
531              mm-security-handle 'gnus-info "Corrupted")
532             (throw 'error handle))
533           (mm-insert-part part)
534           (unless (condition-case err
535                       (prog1
536                           (gpg-verify message signature mml2015-result-buffer)
537                         (mm-set-handle-multipart-parameter
538                          mm-security-handle 'gnus-details
539                          (with-current-buffer mml2015-result-buffer
540                            (buffer-string))))
541                     (error
542                      (mm-set-handle-multipart-parameter
543                       mm-security-handle 'gnus-details (mml2015-format-error err))
544                      (mm-set-handle-multipart-parameter
545                       mm-security-handle 'gnus-info "Error.")
546                      (setq info-is-set-p t)
547                      nil)
548                     (quit
549                      (mm-set-handle-multipart-parameter
550                       mm-security-handle 'gnus-details "Quit.")
551                      (mm-set-handle-multipart-parameter
552                       mm-security-handle 'gnus-info "Quit.")
553                      (setq info-is-set-p t)
554                      nil))
555             (unless info-is-set-p
556               (mm-set-handle-multipart-parameter
557                mm-security-handle 'gnus-info "Failed"))
558             (throw 'error handle)))
559         (mm-set-handle-multipart-parameter
560          mm-security-handle 'gnus-info
561          (with-current-buffer mml2015-result-buffer
562            (mml2015-gpg-extract-signature-details))))
563       handle)))
564
565 (defun mml2015-gpg-clear-verify ()
566   (if (condition-case err
567           (prog1
568               (gpg-verify-cleartext (current-buffer) mml2015-result-buffer)
569             (mm-set-handle-multipart-parameter
570              mm-security-handle 'gnus-details
571              (with-current-buffer mml2015-result-buffer
572                (buffer-string))))
573         (error
574          (mm-set-handle-multipart-parameter
575           mm-security-handle 'gnus-details (mml2015-format-error err))
576          nil)
577         (quit
578          (mm-set-handle-multipart-parameter
579           mm-security-handle 'gnus-details "Quit.")
580          nil))
581       (mm-set-handle-multipart-parameter
582        mm-security-handle 'gnus-info
583        (with-current-buffer mml2015-result-buffer
584          (mml2015-gpg-extract-signature-details)))
585     (mm-set-handle-multipart-parameter
586      mm-security-handle 'gnus-info "Failed")))
587
588 (defun mml2015-gpg-sign (cont)
589   (let ((boundary (mml-compute-boundary cont))
590         (text (current-buffer)) signature)
591     (goto-char (point-max))
592     (unless (bolp)
593       (insert "\n"))
594     (with-temp-buffer
595       (unless (gpg-sign-detached text (setq signature (current-buffer))
596                                  mml2015-result-buffer
597                                  nil
598                                  (message-options-get 'message-sender)
599                                  t t) ; armor & textmode
600         (unless (> (point-max) (point-min))
601           (pop-to-buffer mml2015-result-buffer)
602           (error "Sign error")))
603       (goto-char (point-min))
604       (while (re-search-forward "\r+$" nil t)
605         (replace-match "" t t))
606       (set-buffer text)
607       (goto-char (point-min))
608       (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
609                       boundary))
610       ;;; FIXME: what is the micalg?
611       (insert "\tmicalg=pgp-sha1; protocol=\"application/pgp-signature\"\n")
612       (insert (format "\n--%s\n" boundary))
613       (goto-char (point-max))
614       (insert (format "\n--%s\n" boundary))
615       (insert "Content-Type: application/pgp-signature\n\n")
616       (insert-buffer-substring signature)
617       (goto-char (point-max))
618       (insert (format "--%s--\n" boundary))
619       (goto-char (point-max)))))
620
621 (defun mml2015-gpg-encrypt (cont &optional sign)
622   (let ((boundary (mml-compute-boundary cont))
623         (text (current-buffer))
624         cipher)
625     (mm-with-unibyte-current-buffer
626       (with-temp-buffer
627         ;; set up a function to call the correct gpg encrypt routine
628         ;; with the right arguments. (FIXME: this should be done
629         ;; differently.)
630         (flet ((gpg-encrypt-func
631                  (sign plaintext ciphertext result recipients &optional
632                        passphrase sign-with-key armor textmode)
633                  (if sign
634                      (gpg-sign-encrypt
635                       plaintext ciphertext result recipients passphrase
636                       sign-with-key armor textmode)
637                    (gpg-encrypt
638                     plaintext ciphertext result recipients passphrase
639                     armor textmode))))
640           (unless (gpg-encrypt-func
641                     sign ; passed in when using signencrypt
642                     text (setq cipher (current-buffer))
643                     mml2015-result-buffer
644                     (split-string
645                      (or
646                       (message-options-get 'message-recipients)
647                       (message-options-set 'message-recipients
648                                            (read-string "Recipients: ")))
649                      "[ \f\t\n\r\v,]+")
650                     nil
651                     (message-options-get 'message-sender)
652                     t t) ; armor & textmode
653             (unless (> (point-max) (point-min))
654               (pop-to-buffer mml2015-result-buffer)
655               (error "Encrypt error"))))
656         (goto-char (point-min))
657         (while (re-search-forward "\r+$" nil t)
658           (replace-match "" t t))
659         (set-buffer text)
660         (delete-region (point-min) (point-max))
661         (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
662                         boundary))
663         (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
664         (insert (format "--%s\n" boundary))
665         (insert "Content-Type: application/pgp-encrypted\n\n")
666         (insert "Version: 1\n\n")
667         (insert (format "--%s\n" boundary))
668         (insert "Content-Type: application/octet-stream\n\n")
669         (insert-buffer-substring cipher)
670         (goto-char (point-max))
671         (insert (format "--%s--\n" boundary))
672         (goto-char (point-max))))))
673
674 ;;; pgg wrapper
675
676 (eval-when-compile
677   (defvar pgg-default-user-id)
678   (defvar pgg-errors-buffer)
679   (defvar pgg-output-buffer))
680
681 (eval-and-compile
682   (autoload 'pgg-decrypt-region "pgg")
683   (autoload 'pgg-verify-region "pgg")
684   (autoload 'pgg-sign-region "pgg")
685   (autoload 'pgg-encrypt-region "pgg")
686   (autoload 'pgg-parse-armor "pgg-parse"))
687
688 (defun mml2015-pgg-decrypt (handle ctl)
689   (catch 'error
690     (let ((pgg-errors-buffer mml2015-result-buffer)
691           child handles result decrypt-status)
692       (unless (setq child (mm-find-part-by-type
693                            (cdr handle)
694                            "application/octet-stream" nil t))
695         (mm-set-handle-multipart-parameter
696          mm-security-handle 'gnus-info "Corrupted")
697         (throw 'error handle))
698       (with-temp-buffer
699         (mm-insert-part child)
700         (if (condition-case err
701                 (prog1
702                     (pgg-decrypt-region (point-min) (point-max))
703                   (setq decrypt-status
704                         (with-current-buffer mml2015-result-buffer
705                           (buffer-string)))
706                   (mm-set-handle-multipart-parameter
707                    mm-security-handle 'gnus-details
708                    decrypt-status))
709               (error
710                (mm-set-handle-multipart-parameter
711                 mm-security-handle 'gnus-details (mml2015-format-error err))
712                nil)
713               (quit
714                (mm-set-handle-multipart-parameter
715                 mm-security-handle 'gnus-details "Quit.")
716                nil))
717             (with-current-buffer pgg-output-buffer
718               (goto-char (point-min))
719               (while (search-forward "\r\n" nil t)
720                 (replace-match "\n" t t))
721               (setq handles (mm-dissect-buffer t))
722               (mm-destroy-parts handle)
723               (mm-set-handle-multipart-parameter
724                mm-security-handle 'gnus-info "OK")
725               (mm-set-handle-multipart-parameter
726                mm-security-handle 'gnus-details
727                (concat decrypt-status
728                        (when (stringp (car handles))
729                          "\n" (mm-handle-multipart-ctl-parameter
730                                handles 'gnus-details))))
731               (if (listp (car handles))
732                   handles
733                 (list handles)))
734           (mm-set-handle-multipart-parameter
735            mm-security-handle 'gnus-info "Failed")
736           (throw 'error handle))))))
737
738 (defun mml2015-pgg-clear-decrypt ()
739   (let ((pgg-errors-buffer mml2015-result-buffer))
740     (if (prog1
741             (pgg-decrypt-region (point-min) (point-max))
742           (mm-set-handle-multipart-parameter
743            mm-security-handle 'gnus-details
744            (with-current-buffer mml2015-result-buffer
745              (buffer-string))))
746         (progn
747           (erase-buffer)
748           ;; Treat data which pgg returns as a unibyte string.
749           (mm-disable-multibyte)
750           (insert-buffer-substring pgg-output-buffer)
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-info "OK"))
756       (mm-set-handle-multipart-parameter
757        mm-security-handle 'gnus-info "Failed"))))
758
759 (defun mml2015-pgg-verify (handle ctl)
760   (let ((pgg-errors-buffer mml2015-result-buffer)
761         signature-file part signature)
762     (if (or (null (setq part (mm-find-raw-part-by-type
763                               ctl (or (mm-handle-multipart-ctl-parameter
764                                        ctl 'protocol)
765                                       "application/pgp-signature")
766                               t)))
767             (null (setq signature (mm-find-part-by-type
768                                    (cdr handle) "application/pgp-signature" nil t))))
769         (progn
770           (mm-set-handle-multipart-parameter
771            mm-security-handle 'gnus-info "Corrupted")
772           handle)
773       (with-temp-buffer
774         (insert part)
775         ;; Convert <LF> to <CR><LF> in verify mode.  Sign and
776         ;; clearsign use --textmode. The conversion is not necessary.
777         ;; In clearverify, the conversion is not necessary either.
778         (goto-char (point-min))
779         (end-of-line)
780         (while (not (eobp))
781           (unless (eq (char-before) ?\r)
782             (insert "\r"))
783           (forward-line)
784           (end-of-line))
785         (with-temp-file (setq signature-file (mm-make-temp-file "pgg"))
786           (mm-insert-part signature))
787         (if (condition-case err
788                 (prog1
789                     (pgg-verify-region (point-min) (point-max)
790                                        signature-file t)
791                   (goto-char (point-min))
792                   (while (search-forward "\r\n" nil t)
793                     (replace-match "\n" t t))
794                   (mm-set-handle-multipart-parameter
795                    mm-security-handle 'gnus-details
796                    (concat (with-current-buffer pgg-output-buffer
797                              (buffer-string))
798                            (with-current-buffer pgg-errors-buffer
799                              (buffer-string)))))
800               (error
801                (mm-set-handle-multipart-parameter
802                 mm-security-handle 'gnus-details (mml2015-format-error err))
803                nil)
804               (quit
805                (mm-set-handle-multipart-parameter
806                 mm-security-handle 'gnus-details "Quit.")
807                nil))
808             (progn
809               (delete-file signature-file)
810               (mm-set-handle-multipart-parameter
811                mm-security-handle 'gnus-info
812                (with-current-buffer pgg-errors-buffer
813                  (mml2015-gpg-extract-signature-details))))
814           (delete-file signature-file)
815           (mm-set-handle-multipart-parameter
816            mm-security-handle 'gnus-info "Failed")))))
817   handle)
818
819 (defun mml2015-pgg-clear-verify ()
820   (let ((pgg-errors-buffer mml2015-result-buffer)
821         (text (buffer-string))
822         (coding-system buffer-file-coding-system))
823     (if (condition-case err
824             (prog1
825                 (mm-with-unibyte-buffer
826                   (insert (encode-coding-string text coding-system))
827                   (pgg-verify-region (point-min) (point-max) nil t))
828               (goto-char (point-min))
829               (while (search-forward "\r\n" nil t)
830                 (replace-match "\n" t t))
831               (mm-set-handle-multipart-parameter
832                mm-security-handle 'gnus-details
833                (concat (with-current-buffer pgg-output-buffer
834                          (buffer-string))
835                        (with-current-buffer pgg-errors-buffer
836                          (buffer-string)))))
837           (error
838            (mm-set-handle-multipart-parameter
839             mm-security-handle 'gnus-details (mml2015-format-error err))
840            nil)
841           (quit
842            (mm-set-handle-multipart-parameter
843             mm-security-handle 'gnus-details "Quit.")
844            nil))
845         (mm-set-handle-multipart-parameter
846          mm-security-handle 'gnus-info
847          (with-current-buffer pgg-errors-buffer
848            (mml2015-gpg-extract-signature-details)))
849       (mm-set-handle-multipart-parameter
850        mm-security-handle 'gnus-info "Failed"))))
851
852 (defun mml2015-pgg-sign (cont)
853   (let ((pgg-errors-buffer mml2015-result-buffer)
854         (boundary (mml-compute-boundary cont))
855         (pgg-default-user-id (or (message-options-get 'mml-sender)
856                                  pgg-default-user-id))
857         (pgg-text-mode t)
858         entry)
859     (unless (pgg-sign-region (point-min) (point-max))
860       (pop-to-buffer mml2015-result-buffer)
861       (error "Sign error"))
862     (goto-char (point-min))
863     (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
864                     boundary))
865     (if (setq entry (assq 2 (pgg-parse-armor
866                              (with-current-buffer pgg-output-buffer
867                                (buffer-string)))))
868         (setq entry (assq 'hash-algorithm (cdr entry))))
869     (insert (format "\tmicalg=%s; "
870                     (if (cdr entry)
871                         (downcase (format "pgp-%s" (cdr entry)))
872                       "pgp-sha1")))
873     (insert "protocol=\"application/pgp-signature\"\n")
874     (insert (format "\n--%s\n" boundary))
875     (goto-char (point-max))
876     (insert (format "\n--%s\n" boundary))
877     (insert "Content-Type: application/pgp-signature\n\n")
878     (insert-buffer-substring pgg-output-buffer)
879     (goto-char (point-max))
880     (insert (format "--%s--\n" boundary))
881     (goto-char (point-max))))
882
883 (defun mml2015-pgg-encrypt (cont &optional sign)
884   (let ((pgg-errors-buffer mml2015-result-buffer)
885         (pgg-text-mode t)
886         (boundary (mml-compute-boundary cont)))
887     (unless (pgg-encrypt-region (point-min) (point-max)
888                                 (split-string
889                                  (or
890                                   (message-options-get 'message-recipients)
891                                   (message-options-set 'message-recipients
892                                                        (read-string "Recipients: ")))
893                                  "[ \f\t\n\r\v,]+")
894                                 sign)
895       (pop-to-buffer mml2015-result-buffer)
896       (error "Encrypt error"))
897     (delete-region (point-min) (point-max))
898     (goto-char (point-min))
899     (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
900                     boundary))
901     (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
902     (insert (format "--%s\n" boundary))
903     (insert "Content-Type: application/pgp-encrypted\n\n")
904     (insert "Version: 1\n\n")
905     (insert (format "--%s\n" boundary))
906     (insert "Content-Type: application/octet-stream\n\n")
907     (insert-buffer-substring pgg-output-buffer)
908     (goto-char (point-max))
909     (insert (format "--%s--\n" boundary))
910     (goto-char (point-max))))
911
912 ;;; epg wrapper
913
914 (eval-and-compile
915   (autoload 'epg-make-context "epg"))
916
917 (eval-when-compile
918   (defvar epg-user-id-alist)
919   (defvar epg-digest-algorithm-alist)
920   (defvar inhibit-redisplay)
921   (autoload 'epg-context-set-armor "epg")
922   (autoload 'epg-context-set-textmode "epg")
923   (autoload 'epg-context-set-signers "epg")
924   (autoload 'epg-context-result-for "epg")
925   (autoload 'epg-new-signature-digest-algorithm "epg")
926   (autoload 'epg-verify-result-to-string "epg")
927   (autoload 'epg-list-keys "epg")
928   (autoload 'epg-decrypt-string "epg")
929   (autoload 'epg-verify-string "epg")
930   (autoload 'epg-sign-string "epg")
931   (autoload 'epg-encrypt-string "epg")
932   (autoload 'epg-passphrase-callback-function "epg")
933   (autoload 'epg-context-set-passphrase-callback "epg"))
934
935 (eval-when-compile
936   (defvar password-cache-expiry)
937   (autoload 'password-read "password")
938   (autoload 'password-cache-add "password")
939   (autoload 'password-cache-remove "password"))
940
941 (defvar mml2015-epg-secret-key-id-list nil)
942
943 (defun mml2015-epg-passphrase-callback (context key-id ignore)
944   (if (eq key-id 'SYM)
945       (epg-passphrase-callback-function context key-id nil)
946     (let* ((entry (assoc key-id epg-user-id-alist))
947            (passphrase
948             (password-read
949              (format "GnuPG passphrase for %s: "
950                      (if entry
951                          (cdr entry)
952                        key-id))
953              (if (eq key-id 'PIN)
954                  "PIN"
955                key-id))))
956       (when passphrase
957         (let ((password-cache-expiry mml2015-passphrase-cache-expiry))
958           (password-cache-add key-id passphrase))
959         (setq mml2015-epg-secret-key-id-list
960               (cons key-id mml2015-epg-secret-key-id-list))
961         (copy-sequence passphrase)))))
962
963 (defun mml2015-epg-decrypt (handle ctl)
964   (catch 'error
965     (let ((inhibit-redisplay t)
966           context plain child handles result decrypt-status)
967       (unless (setq child (mm-find-part-by-type
968                            (cdr handle)
969                            "application/octet-stream" nil t))
970         (mm-set-handle-multipart-parameter
971          mm-security-handle 'gnus-info "Corrupted")
972         (throw 'error handle))
973       (setq context (epg-make-context))
974       (if mml2015-cache-passphrase
975           (epg-context-set-passphrase-callback
976            context
977            #'mml2015-epg-passphrase-callback))
978       (condition-case error
979           (setq plain (epg-decrypt-string context (mm-get-part child))
980                 mml2015-epg-secret-key-id-list nil)
981         (error
982          (while mml2015-epg-secret-key-id-list
983            (password-cache-remove (car mml2015-epg-secret-key-id-list))
984            (setq mml2015-epg-secret-key-id-list
985                  (cdr mml2015-epg-secret-key-id-list)))
986          (mm-set-handle-multipart-parameter
987           mm-security-handle 'gnus-info "Failed")
988          (if (eq (car error) 'quit)
989              (mm-set-handle-multipart-parameter
990               mm-security-handle 'gnus-details "Quit.")
991            (mm-set-handle-multipart-parameter
992             mm-security-handle 'gnus-details (mml2015-format-error error)))
993          (throw 'error handle)))
994       (with-temp-buffer
995         (insert plain)
996         (goto-char (point-min))
997         (while (search-forward "\r\n" nil t)
998           (replace-match "\n" t t))
999         (setq handles (mm-dissect-buffer t))
1000         (mm-destroy-parts handle)
1001         (if (epg-context-result-for context 'verify)
1002             (mm-set-handle-multipart-parameter
1003              mm-security-handle 'gnus-info
1004              (concat "OK\n"
1005                      (epg-verify-result-to-string
1006                       (epg-context-result-for context 'verify))))
1007           (mm-set-handle-multipart-parameter
1008            mm-security-handle 'gnus-info "OK"))
1009         (if (stringp (car handles))
1010             (mm-set-handle-multipart-parameter
1011              mm-security-handle 'gnus-details
1012              (mm-handle-multipart-ctl-parameter handles 'gnus-details))))
1013         (if (listp (car handles))
1014             handles
1015           (list handles)))))
1016
1017 (defun mml2015-epg-clear-decrypt ()
1018   (let ((inhibit-redisplay t)
1019         (context (epg-make-context))
1020         plain)
1021     (if mml2015-cache-passphrase
1022         (epg-context-set-passphrase-callback
1023          context
1024          #'mml2015-epg-passphrase-callback))
1025     (condition-case error
1026         (setq plain (epg-decrypt-string context (buffer-string))
1027               mml2015-epg-secret-key-id-list nil)
1028       (error
1029        (while mml2015-epg-secret-key-id-list
1030          (password-cache-remove (car mml2015-epg-secret-key-id-list))
1031          (setq mml2015-epg-secret-key-id-list
1032                (cdr mml2015-epg-secret-key-id-list)))
1033        (mm-set-handle-multipart-parameter
1034         mm-security-handle 'gnus-info "Failed")
1035        (if (eq (car error) 'quit)
1036            (mm-set-handle-multipart-parameter
1037             mm-security-handle 'gnus-details "Quit.")
1038          (mm-set-handle-multipart-parameter
1039           mm-security-handle 'gnus-details (mml2015-format-error error)))))
1040     (when plain
1041       (erase-buffer)
1042       ;; Treat data which epg returns as a unibyte string.
1043       (mm-disable-multibyte)
1044       (insert plain)
1045       (goto-char (point-min))
1046       (while (search-forward "\r\n" nil t)
1047         (replace-match "\n" t t))
1048       (if (epg-context-result-for context 'verify)
1049           (mm-set-handle-multipart-parameter
1050            mm-security-handle 'gnus-info
1051            (concat "OK\n"
1052                    (epg-verify-result-to-string
1053                     (epg-context-result-for context 'verify))))
1054         (mm-set-handle-multipart-parameter
1055          mm-security-handle 'gnus-info "OK")))))
1056
1057 (defun mml2015-epg-verify (handle ctl)
1058   (catch 'error
1059     (let ((inhibit-redisplay t)
1060           context plain signature-file part signature)
1061       (when (or (null (setq part (mm-find-raw-part-by-type
1062                                   ctl (or (mm-handle-multipart-ctl-parameter
1063                                            ctl 'protocol)
1064                                           "application/pgp-signature")
1065                                   t)))
1066                 (null (setq signature (mm-find-part-by-type
1067                                        (cdr handle) "application/pgp-signature"
1068                                        nil t))))
1069         (mm-set-handle-multipart-parameter
1070          mm-security-handle 'gnus-info "Corrupted")
1071         (throw 'error handle))
1072       (setq context (epg-make-context))
1073       (condition-case error
1074           (setq plain (epg-verify-string context (mm-get-part signature) part))
1075         (error
1076          (mm-set-handle-multipart-parameter
1077           mm-security-handle 'gnus-info "Failed")
1078          (if (eq (car error) 'quit)
1079              (mm-set-handle-multipart-parameter
1080               mm-security-handle 'gnus-details "Quit.")
1081            (mm-set-handle-multipart-parameter
1082             mm-security-handle 'gnus-details (mml2015-format-error error)))
1083          (throw 'error handle)))
1084       (mm-set-handle-multipart-parameter
1085        mm-security-handle 'gnus-info
1086        (epg-verify-result-to-string (epg-context-result-for context 'verify)))
1087       handle)))
1088
1089 (defun mml2015-epg-clear-verify ()
1090   (let ((inhibit-redisplay t)
1091         (context (epg-make-context))
1092         (signature (encode-coding-string (buffer-string)
1093                                          buffer-file-coding-system))
1094         plain)
1095     (condition-case error
1096         (setq plain (epg-verify-string context signature))
1097       (error
1098        (mm-set-handle-multipart-parameter
1099         mm-security-handle 'gnus-info "Failed")
1100        (if (eq (car error) 'quit)
1101            (mm-set-handle-multipart-parameter
1102             mm-security-handle 'gnus-details "Quit.")
1103          (mm-set-handle-multipart-parameter
1104           mm-security-handle 'gnus-details (mml2015-format-error error)))))
1105     (if plain
1106         (mm-set-handle-multipart-parameter
1107          mm-security-handle 'gnus-info
1108          (epg-verify-result-to-string
1109           (epg-context-result-for context 'verify))))))
1110
1111 (defun mml2015-epg-sign (cont)
1112   (let ((inhibit-redisplay t)
1113         (context (epg-make-context))
1114         (boundary (mml-compute-boundary cont))
1115         signers signature micalg)
1116     (if mml2015-verbose
1117         (setq signers (epa-select-keys context "Select keys for signing.
1118 If no one is selected, default secret key is used.  "
1119                                        mml2015-signers t))
1120       (if mml2015-signers
1121           (setq signers (mapcar (lambda (name)
1122                                   (car (epg-list-keys context name t)))
1123                                 mml2015-signers))
1124         (setq signers (list (car (epg-list-keys
1125                                   context
1126                                   (message-options-get 'mml-sender)
1127                                   t))))))
1128     (epg-context-set-armor context t)
1129     (epg-context-set-textmode context t)
1130     (epg-context-set-signers context signers)
1131     (if mml2015-cache-passphrase
1132         (epg-context-set-passphrase-callback
1133          context
1134          #'mml2015-epg-passphrase-callback))
1135     (condition-case error
1136         (setq signature (epg-sign-string context (buffer-string) t)
1137               mml2015-epg-secret-key-id-list nil)
1138       (error
1139        (while mml2015-epg-secret-key-id-list
1140          (password-cache-remove (car mml2015-epg-secret-key-id-list))
1141          (setq mml2015-epg-secret-key-id-list
1142                (cdr mml2015-epg-secret-key-id-list)))
1143        (signal (car error) (cdr error))))
1144     (if (epg-context-result-for context 'sign)
1145         (setq micalg (epg-new-signature-digest-algorithm
1146                       (car (epg-context-result-for context 'sign)))))
1147     (goto-char (point-min))
1148     (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
1149                     boundary))
1150     (if micalg
1151         (insert (format "\tmicalg=%s; "
1152                         (downcase
1153                          (cdr (assq micalg
1154                                     epg-digest-algorithm-alist))))))
1155     (insert "protocol=\"application/pgp-signature\"\n")
1156     (insert (format "\n--%s\n" boundary))
1157     (goto-char (point-max))
1158     (insert (format "\n--%s\n" boundary))
1159     (insert "Content-Type: application/pgp-signature\n\n")
1160     (insert signature)
1161     (goto-char (point-max))
1162     (insert (format "--%s--\n" boundary))
1163     (goto-char (point-max))))
1164
1165 (defun mml2015-epg-encrypt (cont &optional sign)
1166   (let ((inhibit-redisplay t)
1167         (context (epg-make-context))
1168         recipients cipher signers
1169         (boundary (mml-compute-boundary cont)))
1170     (if mml2015-verbose
1171         (setq recipients
1172               (epa-select-keys context "Select recipients for encryption.
1173 If no one is selected, symmetric encryption will be performed.  "
1174                                (if (message-options-get 'message-recipients)
1175                                    (split-string
1176                                     (message-options-get 'message-recipients)
1177                                     "[ \f\t\n\r\v,]+"))))
1178       (setq recipients
1179             (mapcar (lambda (name)
1180                       (car (epg-list-keys context name)))
1181                     (if (message-options-get 'message-recipients)
1182                         (split-string
1183                          (message-options-get 'message-recipients)
1184                          "[ \f\t\n\r\v,]+")))))
1185     (if mml2015-encrypt-to-self
1186         (if mml2015-signers
1187             (setq recipients
1188                   (nconc recipients
1189                          (mapcar (lambda (name)
1190                                    (car (epg-list-keys context name)))
1191                                  mml2015-signers)))
1192           (setq recipients
1193                 (nconc recipients
1194                        (list (car (epg-list-keys context nil t)))))))
1195     (when sign
1196       (if mml2015-verbose
1197           (setq signers (epa-select-keys context "Select keys for signing.
1198 If no one is selected, default secret key is used.  "
1199                                          mml2015-signers t))
1200         (if mml2015-signers
1201             (setq signers (mapcar (lambda (name)
1202                                     (car (epg-list-keys context name t)))
1203                                   mml2015-signers))
1204           (setq signers (list (car (epg-list-keys
1205                                     context
1206                                     (message-options-get 'mml-sender)
1207                                     t))))))
1208       (epg-context-set-signers context signers))
1209     (epg-context-set-armor context t)
1210     (epg-context-set-textmode context t)
1211     (if mml2015-cache-passphrase
1212         (epg-context-set-passphrase-callback
1213          context
1214          #'mml2015-epg-passphrase-callback))
1215     (condition-case error
1216         (setq cipher
1217               (epg-encrypt-string context (buffer-string) recipients sign)
1218               mml2015-epg-secret-key-id-list nil)
1219       (error
1220        (while mml2015-epg-secret-key-id-list
1221          (password-cache-remove (car mml2015-epg-secret-key-id-list))
1222          (setq mml2015-epg-secret-key-id-list
1223                (cdr mml2015-epg-secret-key-id-list)))
1224        (signal (car error) (cdr error))))
1225     (delete-region (point-min) (point-max))
1226     (goto-char (point-min))
1227     (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
1228                     boundary))
1229     (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
1230     (insert (format "--%s\n" boundary))
1231     (insert "Content-Type: application/pgp-encrypted\n\n")
1232     (insert "Version: 1\n\n")
1233     (insert (format "--%s\n" boundary))
1234     (insert "Content-Type: application/octet-stream\n\n")
1235     (insert cipher)
1236     (goto-char (point-max))
1237     (insert (format "--%s--\n" boundary))
1238     (goto-char (point-max))))
1239
1240 ;;; General wrapper
1241
1242 (defun mml2015-clean-buffer ()
1243   (if (gnus-buffer-live-p mml2015-result-buffer)
1244       (with-current-buffer mml2015-result-buffer
1245         (erase-buffer)
1246         t)
1247     (setq mml2015-result-buffer
1248           (gnus-get-buffer-create " *MML2015 Result*"))
1249     nil))
1250
1251 (defsubst mml2015-clear-decrypt-function ()
1252   (nth 6 (assq mml2015-use mml2015-function-alist)))
1253
1254 (defsubst mml2015-clear-verify-function ()
1255   (nth 5 (assq mml2015-use mml2015-function-alist)))
1256
1257 ;;;###autoload
1258 (defun mml2015-decrypt (handle ctl)
1259   (mml2015-clean-buffer)
1260   (let ((func (nth 4 (assq mml2015-use mml2015-function-alist))))
1261     (if func
1262         (funcall func handle ctl)
1263       handle)))
1264
1265 ;;;###autoload
1266 (defun mml2015-decrypt-test (handle ctl)
1267   mml2015-use)
1268
1269 ;;;###autoload
1270 (defun mml2015-verify (handle ctl)
1271   (mml2015-clean-buffer)
1272   (let ((func (nth 3 (assq mml2015-use mml2015-function-alist))))
1273     (if func
1274         (funcall func handle ctl)
1275       handle)))
1276
1277 ;;;###autoload
1278 (defun mml2015-verify-test (handle ctl)
1279   mml2015-use)
1280
1281 ;;;###autoload
1282 (defun mml2015-encrypt (cont &optional sign)
1283   (mml2015-clean-buffer)
1284   (let ((func (nth 2 (assq mml2015-use mml2015-function-alist))))
1285     (if func
1286         (funcall func cont sign)
1287       (error "Cannot find encrypt function"))))
1288
1289 ;;;###autoload
1290 (defun mml2015-sign (cont)
1291   (mml2015-clean-buffer)
1292   (let ((func (nth 1 (assq mml2015-use mml2015-function-alist))))
1293     (if func
1294         (funcall func cont)
1295       (error "Cannot find sign function"))))
1296
1297 ;;;###autoload
1298 (defun mml2015-self-encrypt ()
1299   (mml2015-encrypt nil))
1300
1301 (provide 'mml2015)
1302
1303 ;;; arch-tag: b04701d5-0b09-44d8-bed8-de901bf435f2
1304 ;;; mml2015.el ends here