cgit.sxemacs.org Git - gnus/blob - lisp/mml-smime.el

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