lisp/gnus/mml2015.el

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