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