lisp/gnus/mml-smime.el

   1 ;;; mml-smime.el --- S/MIME support for MML
   2
   3 ;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
   4
   5 ;; Author: Simon Josefsson <simon@josefsson.org>
   6 ;; Keywords: Gnus, MIME, S/MIME, MML
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 (eval-when-compile (require 'cl))
  28
  29 (require 'smime)
  30 (require 'mm-decode)
  31 (require 'mml-sec)
  32 (autoload 'message-narrow-to-headers "message")
  33 (autoload 'message-fetch-field "message")
  34
  35 (defcustom mml-smime-use (if (featurep 'epg) 'epg 'openssl)
  36   "Whether to use OpenSSL or EPG to decrypt S/MIME messages.
  37 Defaults to EPG if it's loaded."
  38   :group 'mime-security
  39   :type '(choice (const :tag "EPG" epg)
  40                  (const :tag "OpenSSL" openssl)))
  41
  42 (defvar mml-smime-function-alist
  43   '((openssl mml-smime-openssl-sign
  44              mml-smime-openssl-encrypt
  45              mml-smime-openssl-sign-query
  46              mml-smime-openssl-encrypt-query
  47              mml-smime-openssl-verify
  48              mml-smime-openssl-verify-test)
  49     (epg mml-smime-epg-sign
  50          mml-smime-epg-encrypt
  51          nil
  52          nil
  53          mml-smime-epg-verify
  54          mml-smime-epg-verify-test)))
  55
  56 (defcustom mml-smime-cache-passphrase mml-secure-cache-passphrase
  57   "If t, cache passphrase."
  58   :group 'mime-security
  59   :type 'boolean)
  60
  61 (defcustom mml-smime-passphrase-cache-expiry mml-secure-passphrase-cache-expiry
  62   "How many seconds the passphrase is cached.
  63 Whether the passphrase is cached at all is controlled by
  64 `mml-smime-cache-passphrase'."
  65   :group 'mime-security
  66   :type 'integer)
  67
  68 (defcustom mml-smime-signers nil
  69   "A list of your own key ID which will be used to sign a message."
  70   :group 'mime-security
  71   :type '(repeat (string :tag "Key ID")))
  72
  73 (defcustom mml-smime-sign-with-sender nil
  74   "If t, use message sender so find a key to sign with."
  75   :group 'mime-security
  76   :version "24.4"
  77   :type 'boolean)
  78
  79 (defcustom mml-smime-encrypt-to-self nil
  80   "If t, add your own key ID to recipient list when encryption."
  81   :group 'mime-security
  82   :version "24.4"
  83   :type 'boolean)
  84
  85 (defun mml-smime-sign (cont)
  86   (let ((func (nth 1 (assq mml-smime-use mml-smime-function-alist))))
  87     (if func
  88         (funcall func cont)
  89       (error "Cannot find sign function"))))
  90
  91 (defun mml-smime-encrypt (cont)
  92   (let ((func (nth 2 (assq mml-smime-use mml-smime-function-alist))))
  93     (if func
  94         (funcall func cont)
  95       (error "Cannot find encrypt function"))))
  96
  97 (defun mml-smime-sign-query ()
  98   (let ((func (nth 3 (assq mml-smime-use mml-smime-function-alist))))
  99     (if func
 100         (funcall func))))
 101
 102 (defun mml-smime-encrypt-query ()
 103   (let ((func (nth 4 (assq mml-smime-use mml-smime-function-alist))))
 104     (if func
 105         (funcall func))))
 106
 107 (defun mml-smime-verify (handle ctl)
 108   (let ((func (nth 5 (assq mml-smime-use mml-smime-function-alist))))
 109     (if func
 110         (funcall func handle ctl)
 111       handle)))
 112
 113 (defun mml-smime-verify-test (handle ctl)
 114   (let ((func (nth 6 (assq mml-smime-use mml-smime-function-alist))))
 115     (if func
 116         (funcall func handle ctl))))
 117
 118 (defun mml-smime-openssl-sign (cont)
 119   (when (null smime-keys)
 120     (customize-variable 'smime-keys)
 121     (error "No S/MIME keys configured, use customize to add your key"))
 122   (smime-sign-buffer (cdr (assq 'keyfile cont)))
 123   (goto-char (point-min))
 124   (while (search-forward "\r\n" nil t)
 125     (replace-match "\n" t t))
 126   (goto-char (point-max)))
 127
 128 (defun mml-smime-openssl-encrypt (cont)
 129   (let (certnames certfiles tmp file tmpfiles)
 130     ;; xxx tmp files are always an security issue
 131     (while (setq tmp (pop cont))
 132       (if (and (consp tmp) (eq (car tmp) 'certfile))
 133           (push (cdr tmp) certnames)))
 134     (while (setq tmp (pop certnames))
 135       (if (not (and (not (file-exists-p tmp))
 136                     (get-buffer tmp)))
 137           (push tmp certfiles)
 138         (setq file (mm-make-temp-file (expand-file-name "mml."
 139                                                         mm-tmp-directory)))
 140         (with-current-buffer tmp
 141           (write-region (point-min) (point-max) file))
 142         (push file certfiles)
 143         (push file tmpfiles)))
 144     (if (smime-encrypt-buffer certfiles)
 145         (progn
 146           (while (setq tmp (pop tmpfiles))
 147             (delete-file tmp))
 148           t)
 149       (while (setq tmp (pop tmpfiles))
 150         (delete-file tmp))
 151       nil))
 152   (goto-char (point-max)))
 153
 154 (defvar gnus-extract-address-components)
 155
 156 (defun mml-smime-openssl-sign-query ()
 157   ;; query information (what certificate) from user when MML tag is
 158   ;; added, for use later by the signing process
 159   (when (null smime-keys)
 160     (customize-variable 'smime-keys)
 161     (error "No S/MIME keys configured, use customize to add your key"))
 162   (list 'keyfile
 163         (if (= (length smime-keys) 1)
 164             (cadar smime-keys)
 165           (or (let ((from (cadr (funcall (if (boundp
 166                                               'gnus-extract-address-components)
 167                                              gnus-extract-address-components
 168                                            'mail-extract-address-components)
 169                                          (or (save-excursion
 170                                                (save-restriction
 171                                                  (message-narrow-to-headers)
 172                                                  (message-fetch-field "from")))
 173                                              "")))))
 174                 (and from (smime-get-key-by-email from)))
 175               (smime-get-key-by-email
 176                (gnus-completing-read "Sign this part with what signature"
 177                                      (mapcar 'car smime-keys) nil nil nil
 178                                      (and (listp (car-safe smime-keys))
 179                                           (caar smime-keys))))))))
 180
 181 (defun mml-smime-get-file-cert ()
 182   (ignore-errors
 183     (list 'certfile (read-file-name
 184                      "File with recipient's S/MIME certificate: "
 185                      smime-certificate-directory nil t ""))))
 186
 187 (defun mml-smime-get-dns-cert ()
 188   ;; todo: deal with comma separated multiple recipients
 189   (let (result who bad cert)
 190     (condition-case ()
 191         (while (not result)
 192           (setq who (read-from-minibuffer
 193                      (format "%sLookup certificate for: " (or bad ""))
 194                      (cadr (funcall (if (boundp
 195                                          'gnus-extract-address-components)
 196                                         gnus-extract-address-components
 197                                       'mail-extract-address-components)
 198                                     (or (save-excursion
 199                                           (save-restriction
 200                                             (message-narrow-to-headers)
 201                                             (message-fetch-field "to")))
 202                                         "")))))
 203           (if (setq cert (smime-cert-by-dns who))
 204               (setq result (list 'certfile (buffer-name cert)))
 205             (setq bad (format "`%s' not found. " who))))
 206       (quit))
 207     result))
 208
 209 (defun mml-smime-get-ldap-cert ()
 210   ;; todo: deal with comma separated multiple recipients
 211   (let (result who bad cert)
 212     (condition-case ()
 213         (while (not result)
 214           (setq who (read-from-minibuffer
 215                      (format "%sLookup certificate for: " (or bad ""))
 216                      (cadr (funcall gnus-extract-address-components
 217                                     (or (save-excursion
 218                                           (save-restriction
 219                                             (message-narrow-to-headers)
 220                                             (message-fetch-field "to")))
 221                                         "")))))
 222           (if (setq cert (smime-cert-by-ldap who))
 223               (setq result (list 'certfile (buffer-name cert)))
 224             (setq bad (format "`%s' not found. " who))))
 225       (quit))
 226     result))
 227
 228 (autoload 'gnus-completing-read "gnus-util")
 229
 230 (defun mml-smime-openssl-encrypt-query ()
 231   ;; todo: try dns/ldap automatically first, before prompting user
 232   (let (certs done)
 233     (while (not done)
 234       (ecase (read (gnus-completing-read
 235                     "Fetch certificate from"
 236                     '("dns" "ldap" "file") t nil nil
 237                     "ldap"))
 238         (dns (setq certs (append certs
 239                                  (mml-smime-get-dns-cert))))
 240         (ldap (setq certs (append certs
 241                                   (mml-smime-get-ldap-cert))))
 242         (file (setq certs (append certs
 243                                   (mml-smime-get-file-cert)))))
 244       (setq done (not (y-or-n-p "Add more recipients? "))))
 245     certs))
 246
 247 (defun mml-smime-openssl-verify (handle ctl)
 248   (with-temp-buffer
 249     (insert-buffer-substring (mm-handle-multipart-original-buffer ctl))
 250     (goto-char (point-min))
 251     (insert (format "Content-Type: %s; " (mm-handle-media-type ctl)))
 252     (insert (format "protocol=\"%s\"; "
 253                     (mm-handle-multipart-ctl-parameter ctl 'protocol)))
 254     (insert (format "micalg=\"%s\"; "
 255                     (mm-handle-multipart-ctl-parameter ctl 'micalg)))
 256     (insert (format "boundary=\"%s\"\n\n"
 257                     (mm-handle-multipart-ctl-parameter ctl 'boundary)))
 258     (when (get-buffer smime-details-buffer)
 259       (kill-buffer smime-details-buffer))
 260     (let ((buf (current-buffer))
 261           (good-signature (smime-noverify-buffer))
 262           (good-certificate (and (or smime-CA-file smime-CA-directory)
 263                                  (smime-verify-buffer)))
 264           addresses openssl-output)
 265       (setq openssl-output (with-current-buffer smime-details-buffer
 266                              (buffer-string)))
 267       (if (not good-signature)
 268           (progn
 269             ;; we couldn't verify message, fail with openssl output as message
 270             (mm-set-handle-multipart-parameter
 271              mm-security-handle 'gnus-info "Failed")
 272             (mm-set-handle-multipart-parameter
 273              mm-security-handle 'gnus-details
 274              (concat "OpenSSL failed to verify message integrity:\n"
 275                      "-------------------------------------------\n"
 276                      openssl-output)))
 277         ;; verify mail addresses in mail against those in certificate
 278         (when (and (smime-pkcs7-region (point-min) (point-max))
 279                    (smime-pkcs7-certificates-region (point-min) (point-max)))
 280           (with-temp-buffer
 281             (insert-buffer-substring buf)
 282             (goto-char (point-min))
 283             (while (re-search-forward "-----END CERTIFICATE-----" nil t)
 284               (when (smime-pkcs7-email-region (point-min) (point))
 285                 (setq addresses (append (smime-buffer-as-string-region
 286                                          (point-min) (point)) addresses)))
 287               (delete-region (point-min) (point)))
 288             (setq addresses (mapcar 'downcase addresses))))
 289         (if (not (member (downcase (or (mm-handle-multipart-from ctl) "")) addresses))
 290             (mm-set-handle-multipart-parameter
 291              mm-security-handle 'gnus-info "Sender address forged")
 292           (if good-certificate
 293               (mm-set-handle-multipart-parameter
 294                mm-security-handle 'gnus-info "Ok (sender authenticated)")
 295             (mm-set-handle-multipart-parameter
 296              mm-security-handle 'gnus-info "Ok (sender not trusted)")))
 297         (mm-set-handle-multipart-parameter
 298          mm-security-handle 'gnus-details
 299          (concat "Sender claimed to be: " (mm-handle-multipart-from ctl) "\n"
 300                  (if addresses
 301                      (concat "Addresses in certificate: "
 302                              (mapconcat 'identity addresses ", "))
 303                    "No addresses found in certificate. (Requires OpenSSL 0.9.6 or later.)")
 304                  "\n" "\n"
 305                  "OpenSSL output:\n"
 306                  "---------------\n" openssl-output "\n"
 307                  "Certificate(s) inside S/MIME signature:\n"
 308                  "---------------------------------------\n"
 309                  (buffer-string) "\n")))))
 310   handle)
 311
 312 (defun mml-smime-openssl-verify-test (handle ctl)
 313   smime-openssl-program)
 314
 315 (defvar epg-user-id-alist)
 316 (defvar epg-digest-algorithm-alist)
 317 (defvar inhibit-redisplay)
 318 (defvar password-cache-expiry)
 319
 320 (eval-when-compile
 321   (autoload 'epg-make-context "epg")
 322   (autoload 'epg-context-set-armor "epg")
 323   (autoload 'epg-context-set-signers "epg")
 324   (autoload 'epg-context-result-for "epg")
 325   (autoload 'epg-new-signature-digest-algorithm "epg")
 326   (autoload 'epg-verify-result-to-string "epg")
 327   (autoload 'epg-list-keys "epg")
 328   (autoload 'epg-decrypt-string "epg")
 329   (autoload 'epg-verify-string "epg")
 330   (autoload 'epg-sign-string "epg")
 331   (autoload 'epg-encrypt-string "epg")
 332   (autoload 'epg-passphrase-callback-function "epg")
 333   (autoload 'epg-context-set-passphrase-callback "epg")
 334   (autoload 'epg-sub-key-fingerprint "epg")
 335   (autoload 'epg-configuration "epg-config")
 336   (autoload 'epg-expand-group "epg-config")
 337   (autoload 'epa-select-keys "epa"))
 338
 339 (defvar mml-smime-epg-secret-key-id-list nil)
 340
 341 (defun mml-smime-epg-passphrase-callback (context key-id ignore)
 342   (if (eq key-id 'SYM)
 343       (epg-passphrase-callback-function context key-id nil)
 344     (let* (entry
 345            (passphrase
 346             (password-read
 347              (if (eq key-id 'PIN)
 348                  "Passphrase for PIN: "
 349                (if (setq entry (assoc key-id epg-user-id-alist))
 350                    (format "Passphrase for %s %s: " key-id (cdr entry))
 351                  (format "Passphrase for %s: " key-id)))
 352              (if (eq key-id 'PIN)
 353                  "PIN"
 354                key-id))))
 355       (when passphrase
 356         (let ((password-cache-expiry mml-smime-passphrase-cache-expiry))
 357           (password-cache-add key-id passphrase))
 358         (setq mml-smime-epg-secret-key-id-list
 359               (cons key-id mml-smime-epg-secret-key-id-list))
 360         (copy-sequence passphrase)))))
 361
 362 (declare-function epg-key-sub-key-list   "ext:epg" (key))
 363 (declare-function epg-sub-key-capability "ext:epg" (sub-key))
 364 (declare-function epg-sub-key-validity   "ext:epg" (sub-key))
 365
 366 (defun mml-smime-epg-find-usable-key (keys usage)
 367   (catch 'found
 368     (while keys
 369       (let ((pointer (epg-key-sub-key-list (car keys))))
 370         (while pointer
 371           (if (and (memq usage (epg-sub-key-capability (car pointer)))
 372                    (not (memq (epg-sub-key-validity (car pointer))
 373                               '(revoked expired))))
 374               (throw 'found (car keys)))
 375           (setq pointer (cdr pointer))))
 376       (setq keys (cdr keys)))))
 377
 378 ;; XXX: since gpg --list-secret-keys does not return validity of each
 379 ;; key, `mml-smime-epg-find-usable-key' defined above is not enough for
 380 ;; secret keys.  The function `mml-smime-epg-find-usable-secret-key'
 381 ;; below looks at appropriate public keys to check usability.
 382 (defun mml-smime-epg-find-usable-secret-key (context name usage)
 383   (let ((secret-keys (epg-list-keys context name t))
 384         secret-key)
 385     (while (and (not secret-key) secret-keys)
 386       (if (mml-smime-epg-find-usable-key
 387            (epg-list-keys context (epg-sub-key-fingerprint
 388                                    (car (epg-key-sub-key-list
 389                                          (car secret-keys)))))
 390            usage)
 391           (setq secret-key (car secret-keys)
 392                 secret-keys nil)
 393         (setq secret-keys (cdr secret-keys))))
 394     secret-key))
 395
 396 (autoload 'mml-compute-boundary "mml")
 397
 398 ;; We require mm-decode, which requires mm-bodies, which autoloads
 399 ;; message-options-get (!).
 400 (declare-function message-options-set "message" (symbol value))
 401
 402 (defun mml-smime-epg-sign (cont)
 403   (let* ((inhibit-redisplay t)
 404          (context (epg-make-context 'CMS))
 405          (boundary (mml-compute-boundary cont))
 406          (sender (message-options-get 'message-sender))
 407          (signer-names (or mml-smime-signers
 408                            (if (and mml-smime-sign-with-sender sender)
 409                                (list (concat "<" sender ">")))))
 410          signer-key
 411          (signers
 412           (or (message-options-get 'mml-smime-epg-signers)
 413               (message-options-set
 414                'mml-smime-epg-signers
 415                (if (eq mm-sign-option 'guided)
 416                    (epa-select-keys context "\
 417 Select keys for signing.
 418 If no one is selected, default secret key is used.  "
 419                                     signer-names
 420                                     t)
 421                  (if (or sender mml-smime-signers)
 422                      (delq nil
 423                            (mapcar
 424                             (lambda (signer)
 425                               (setq signer-key
 426                                     (mml-smime-epg-find-usable-secret-key
 427                                      context signer 'sign))
 428                               (unless (or signer-key
 429                                           (y-or-n-p
 430                                            (format
 431                                             "No secret key for %s; skip it? "
 432                                             signer)))
 433                                 (error "No secret key for %s" signer))
 434                               signer-key)
 435                             signer-names)))))))
 436          signature micalg)
 437     (epg-context-set-signers context signers)
 438     (if mml-smime-cache-passphrase
 439         (epg-context-set-passphrase-callback
 440          context
 441          #'mml-smime-epg-passphrase-callback))
 442     (condition-case error
 443         (setq signature (epg-sign-string context
 444                                          (mm-replace-in-string (buffer-string)
 445                                                                "\n" "\r\n")
 446                                          t)
 447               mml-smime-epg-secret-key-id-list nil)
 448       (error
 449        (while mml-smime-epg-secret-key-id-list
 450          (password-cache-remove (car mml-smime-epg-secret-key-id-list))
 451          (setq mml-smime-epg-secret-key-id-list
 452                (cdr mml-smime-epg-secret-key-id-list)))
 453        (signal (car error) (cdr error))))
 454     (if (epg-context-result-for context 'sign)
 455         (setq micalg (epg-new-signature-digest-algorithm
 456                       (car (epg-context-result-for context 'sign)))))
 457     (goto-char (point-min))
 458     (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
 459                     boundary))
 460     (if micalg
 461         (insert (format "\tmicalg=%s; "
 462                         (downcase
 463                          (cdr (assq micalg
 464                                     epg-digest-algorithm-alist))))))
 465     (insert "protocol=\"application/pkcs7-signature\"\n")
 466     (insert (format "\n--%s\n" boundary))
 467     (goto-char (point-max))
 468     (insert (format "\n--%s\n" boundary))
 469     (insert "Content-Type: application/pkcs7-signature; name=smime.p7s
 470 Content-Transfer-Encoding: base64
 471 Content-Disposition: attachment; filename=smime.p7s
 472
 473 ")
 474     (insert (base64-encode-string signature) "\n")
 475     (goto-char (point-max))
 476     (insert (format "--%s--\n" boundary))
 477     (goto-char (point-max))))
 478
 479 (defun mml-smime-epg-encrypt (cont)
 480   (let* ((inhibit-redisplay t)
 481          (context (epg-make-context 'CMS))
 482          (config (epg-configuration))
 483          (recipients (message-options-get 'mml-smime-epg-recipients))
 484          cipher signers
 485          (sender (message-options-get 'message-sender))
 486          (signer-names (or mml-smime-signers
 487                            (if (and mml-smime-sign-with-sender sender)
 488                                (list (concat "<" sender ">")))))
 489          (boundary (mml-compute-boundary cont))
 490          recipient-key)
 491     (unless recipients
 492       (setq recipients
 493             (apply #'nconc
 494                    (mapcar
 495                     (lambda (recipient)
 496                       (or (epg-expand-group config recipient)
 497                           (list recipient)))
 498                     (split-string
 499                      (or (message-options-get 'message-recipients)
 500                          (message-options-set 'message-recipients
 501                                               (read-string "Recipients: ")))
 502                      "[ \f\t\n\r\v,]+"))))
 503       (when mml-smime-encrypt-to-self
 504         (unless signer-names
 505           (error "Neither message sender nor mml-smime-signers are set"))
 506         (setq recipients (nconc recipients signer-names)))
 507       (if (eq mm-encrypt-option 'guided)
 508           (setq recipients
 509                 (epa-select-keys context "\
 510 Select recipients for encryption.
 511 If no one is selected, symmetric encryption will be performed.  "
 512                                  recipients))
 513         (setq recipients
 514               (mapcar
 515                (lambda (recipient)
 516                  (setq recipient-key (mml-smime-epg-find-usable-key
 517                                       (epg-list-keys context recipient)
 518                                       'encrypt))
 519                  (unless (or recipient-key
 520                              (y-or-n-p
 521                               (format "No public key for %s; skip it? "
 522                                       recipient)))
 523                    (error "No public key for %s" recipient))
 524                  recipient-key)
 525                recipients))
 526         (unless recipients
 527           (error "No recipient specified")))
 528       (message-options-set 'mml-smime-epg-recipients recipients))
 529     (if mml-smime-cache-passphrase
 530         (epg-context-set-passphrase-callback
 531          context
 532          #'mml-smime-epg-passphrase-callback))
 533     (condition-case error
 534         (setq cipher
 535               (epg-encrypt-string context (buffer-string) recipients)
 536               mml-smime-epg-secret-key-id-list nil)
 537       (error
 538        (while mml-smime-epg-secret-key-id-list
 539          (password-cache-remove (car mml-smime-epg-secret-key-id-list))
 540          (setq mml-smime-epg-secret-key-id-list
 541                (cdr mml-smime-epg-secret-key-id-list)))
 542        (signal (car error) (cdr error))))
 543     (delete-region (point-min) (point-max))
 544     (goto-char (point-min))
 545     (insert "\
 546 Content-Type: application/pkcs7-mime;
 547  smime-type=enveloped-data;
 548  name=smime.p7m
 549 Content-Transfer-Encoding: base64
 550 Content-Disposition: attachment; filename=smime.p7m
 551
 552 ")
 553     (insert (base64-encode-string cipher))
 554     (goto-char (point-max))))
 555
 556 (defun mml-smime-epg-verify (handle ctl)
 557   (catch 'error
 558     (let ((inhibit-redisplay t)
 559           context plain signature-file part signature)
 560       (when (or (null (setq part (mm-find-raw-part-by-type
 561                                   ctl (or (mm-handle-multipart-ctl-parameter
 562                                            ctl 'protocol)
 563                                           "application/pkcs7-signature")
 564                                   t)))
 565                 (null (setq signature (or (mm-find-part-by-type
 566                                            (cdr handle)
 567                                            "application/pkcs7-signature"
 568                                            nil t)
 569                                           (mm-find-part-by-type
 570                                            (cdr handle)
 571                                            "application/x-pkcs7-signature"
 572                                            nil t)))))
 573         (mm-set-handle-multipart-parameter
 574          mm-security-handle 'gnus-info "Corrupted")
 575         (throw 'error handle))
 576       (setq part (mm-replace-in-string part "\n" "\r\n")
 577             context (epg-make-context 'CMS))
 578       (condition-case error
 579           (setq plain (epg-verify-string context (mm-get-part signature) part))
 580         (error
 581          (mm-set-handle-multipart-parameter
 582           mm-security-handle 'gnus-info "Failed")
 583          (if (eq (car error) 'quit)
 584              (mm-set-handle-multipart-parameter
 585               mm-security-handle 'gnus-details "Quit.")
 586            (mm-set-handle-multipart-parameter
 587             mm-security-handle 'gnus-details (format "%S" error)))
 588          (throw 'error handle)))
 589       (mm-set-handle-multipart-parameter
 590        mm-security-handle 'gnus-info
 591        (epg-verify-result-to-string (epg-context-result-for context 'verify)))
 592       handle)))
 593
 594 (defun mml-smime-epg-verify-test (handle ctl)
 595   t)
 596
 597 (provide 'mml-smime)
 598
 599 ;;; mml-smime.el ends here