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-configuration "epg-config")
 333   (autoload 'epg-expand-group "epg-config")
 334   (autoload 'epa-select-keys "epa"))
 335
 336 (defvar mml-smime-epg-secret-key-id-list nil)
 337
 338 (defun mml-smime-epg-passphrase-callback (context key-id ignore)
 339   (if (eq key-id 'SYM)
 340       (epg-passphrase-callback-function context key-id nil)
 341     (let* (entry
 342            (passphrase
 343             (password-read
 344              (if (eq key-id 'PIN)
 345                  "Passphrase for PIN: "
 346                (if (setq entry (assoc key-id epg-user-id-alist))
 347                    (format "Passphrase for %s %s: " key-id (cdr entry))
 348                  (format "Passphrase for %s: " key-id)))
 349              (if (eq key-id 'PIN)
 350                  "PIN"
 351                key-id))))
 352       (when passphrase
 353         (let ((password-cache-expiry mml-smime-passphrase-cache-expiry))
 354           (password-cache-add key-id passphrase))
 355         (setq mml-smime-epg-secret-key-id-list
 356               (cons key-id mml-smime-epg-secret-key-id-list))
 357         (copy-sequence passphrase)))))
 358
 359 (declare-function epg-key-sub-key-list   "ext:epg" (key))
 360 (declare-function epg-sub-key-capability "ext:epg" (sub-key))
 361 (declare-function epg-sub-key-validity   "ext:epg" (sub-key))
 362
 363 (defun mml-smime-epg-find-usable-key (keys usage)
 364   (catch 'found
 365     (while keys
 366       (let ((pointer (epg-key-sub-key-list (car keys))))
 367         (while pointer
 368           (if (and (memq usage (epg-sub-key-capability (car pointer)))
 369                    (not (memq (epg-sub-key-validity (car pointer))
 370                               '(revoked expired))))
 371               (throw 'found (car keys)))
 372           (setq pointer (cdr pointer))))
 373       (setq keys (cdr keys)))))
 374
 375 ;; XXX: since gpg --list-secret-keys does not return validity of each
 376 ;; key, `mml-smime-epg-find-usable-key' defined above is not enough for
 377 ;; secret keys.  The function `mml-smime-epg-find-usable-secret-key'
 378 ;; below looks at appropriate public keys to check usability.
 379 (defun mml-smime-epg-find-usable-secret-key (context name usage)
 380   (let ((secret-keys (epg-list-keys context name t))
 381         secret-key)
 382     (while (and (not secret-key) secret-keys)
 383       (if (mml-smime-epg-find-usable-key
 384            (epg-list-keys context (epg-sub-key-fingerprint
 385                                    (car (epg-key-sub-key-list
 386                                          (car secret-keys)))))
 387            usage)
 388           (setq secret-key (car secret-keys)
 389                 secret-keys nil)
 390         (setq secret-keys (cdr secret-keys))))
 391     secret-key))
 392
 393 (autoload 'mml-compute-boundary "mml")
 394
 395 ;; We require mm-decode, which requires mm-bodies, which autoloads
 396 ;; message-options-get (!).
 397 (declare-function message-options-set "message" (symbol value))
 398
 399 (defun mml-smime-epg-sign (cont)
 400   (let* ((inhibit-redisplay t)
 401          (context (epg-make-context 'CMS))
 402          (boundary (mml-compute-boundary cont))
 403          (sender (message-options-get 'message-sender))
 404          (signer-names (or mml-smime-signers
 405                            (if (and mml-smime-sign-with-sender sender)
 406                                (list (concat "<" sender ">")))))
 407          signer-key
 408          (signers
 409           (or (message-options-get 'mml-smime-epg-signers)
 410               (message-options-set
 411                'mml-smime-epg-signers
 412                (if (eq mm-sign-option 'guided)
 413                    (epa-select-keys context "\
 414 Select keys for signing.
 415 If no one is selected, default secret key is used.  "
 416                                     signer-names
 417                                     t)
 418                  (if (or sender mml-smime-signers)
 419                      (delq nil
 420                            (mapcar
 421                             (lambda (signer)
 422                               (setq signer-key
 423                                     (mml-smime-epg-find-usable-secret-key
 424                                      context signer 'sign))
 425                               (unless (or signer-key
 426                                           (y-or-n-p
 427                                            (format
 428                                             "No secret key for %s; skip it? "
 429                                             signer)))
 430                                 (error "No secret key for %s" signer))
 431                               signer-key)
 432                             signer-names)))))))
 433          signature micalg)
 434     (epg-context-set-signers context signers)
 435     (if mml-smime-cache-passphrase
 436         (epg-context-set-passphrase-callback
 437          context
 438          #'mml-smime-epg-passphrase-callback))
 439     (condition-case error
 440         (setq signature (epg-sign-string context
 441                                          (mm-replace-in-string (buffer-string)
 442                                                                "\n" "\r\n")
 443                                          t)
 444               mml-smime-epg-secret-key-id-list nil)
 445       (error
 446        (while mml-smime-epg-secret-key-id-list
 447          (password-cache-remove (car mml-smime-epg-secret-key-id-list))
 448          (setq mml-smime-epg-secret-key-id-list
 449                (cdr mml-smime-epg-secret-key-id-list)))
 450        (signal (car error) (cdr error))))
 451     (if (epg-context-result-for context 'sign)
 452         (setq micalg (epg-new-signature-digest-algorithm
 453                       (car (epg-context-result-for context 'sign)))))
 454     (goto-char (point-min))
 455     (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
 456                     boundary))
 457     (if micalg
 458         (insert (format "\tmicalg=%s; "
 459                         (downcase
 460                          (cdr (assq micalg
 461                                     epg-digest-algorithm-alist))))))
 462     (insert "protocol=\"application/pkcs7-signature\"\n")
 463     (insert (format "\n--%s\n" boundary))
 464     (goto-char (point-max))
 465     (insert (format "\n--%s\n" boundary))
 466     (insert "Content-Type: application/pkcs7-signature; name=smime.p7s
 467 Content-Transfer-Encoding: base64
 468 Content-Disposition: attachment; filename=smime.p7s
 469
 470 ")
 471     (insert (base64-encode-string signature) "\n")
 472     (goto-char (point-max))
 473     (insert (format "--%s--\n" boundary))
 474     (goto-char (point-max))))
 475
 476 (defun mml-smime-epg-encrypt (cont)
 477   (let ((inhibit-redisplay t)
 478         (context (epg-make-context 'CMS))
 479         (config (epg-configuration))
 480         (recipients (message-options-get 'mml-smime-epg-recipients))
 481         cipher signers
 482         (boundary (mml-compute-boundary cont))
 483         recipient-key)
 484     (unless recipients
 485       (setq recipients
 486             (apply #'nconc
 487                    (mapcar
 488                     (lambda (recipient)
 489                       (or (epg-expand-group config recipient)
 490                           (list recipient)))
 491                     (split-string
 492                      (or (message-options-get 'message-recipients)
 493                          (message-options-set 'message-recipients
 494                                               (read-string "Recipients: ")))
 495                      "[ \f\t\n\r\v,]+"))))
 496       (if (eq mm-encrypt-option 'guided)
 497           (setq recipients
 498                 (epa-select-keys context "\
 499 Select recipients for encryption.
 500 If no one is selected, symmetric encryption will be performed.  "
 501                                  recipients))
 502         (setq recipients
 503               (mapcar
 504                (lambda (recipient)
 505                  (setq recipient-key (mml-smime-epg-find-usable-key
 506                                       (epg-list-keys context recipient)
 507                                       'encrypt))
 508                  (unless (or recipient-key
 509                              (y-or-n-p
 510                               (format "No public key for %s; skip it? "
 511                                       recipient)))
 512                    (error "No public key for %s" recipient))
 513                  recipient-key)
 514                recipients))
 515         (unless recipients
 516           (error "No recipient specified")))
 517       (message-options-set 'mml-smime-epg-recipients recipients))
 518     (if mml-smime-cache-passphrase
 519         (epg-context-set-passphrase-callback
 520          context
 521          #'mml-smime-epg-passphrase-callback))
 522     (condition-case error
 523         (setq cipher
 524               (epg-encrypt-string context (buffer-string) recipients)
 525               mml-smime-epg-secret-key-id-list nil)
 526       (error
 527        (while mml-smime-epg-secret-key-id-list
 528          (password-cache-remove (car mml-smime-epg-secret-key-id-list))
 529          (setq mml-smime-epg-secret-key-id-list
 530                (cdr mml-smime-epg-secret-key-id-list)))
 531        (signal (car error) (cdr error))))
 532     (delete-region (point-min) (point-max))
 533     (goto-char (point-min))
 534     (insert "\
 535 Content-Type: application/pkcs7-mime;
 536  smime-type=enveloped-data;
 537  name=smime.p7m
 538 Content-Transfer-Encoding: base64
 539 Content-Disposition: attachment; filename=smime.p7m
 540
 541 ")
 542     (insert (base64-encode-string cipher))
 543     (goto-char (point-max))))
 544
 545 (defun mml-smime-epg-verify (handle ctl)
 546   (catch 'error
 547     (let ((inhibit-redisplay t)
 548           context plain signature-file part signature)
 549       (when (or (null (setq part (mm-find-raw-part-by-type
 550                                   ctl (or (mm-handle-multipart-ctl-parameter
 551                                            ctl 'protocol)
 552                                           "application/pkcs7-signature")
 553                                   t)))
 554                 (null (setq signature (or (mm-find-part-by-type
 555                                            (cdr handle)
 556                                            "application/pkcs7-signature"
 557                                            nil t)
 558                                           (mm-find-part-by-type
 559                                            (cdr handle)
 560                                            "application/x-pkcs7-signature"
 561                                            nil t)))))
 562         (mm-set-handle-multipart-parameter
 563          mm-security-handle 'gnus-info "Corrupted")
 564         (throw 'error handle))
 565       (setq part (mm-replace-in-string part "\n" "\r\n")
 566             context (epg-make-context 'CMS))
 567       (condition-case error
 568           (setq plain (epg-verify-string context (mm-get-part signature) part))
 569         (error
 570          (mm-set-handle-multipart-parameter
 571           mm-security-handle 'gnus-info "Failed")
 572          (if (eq (car error) 'quit)
 573              (mm-set-handle-multipart-parameter
 574               mm-security-handle 'gnus-details "Quit.")
 575            (mm-set-handle-multipart-parameter
 576             mm-security-handle 'gnus-details (format "%S" error)))
 577          (throw 'error handle)))
 578       (mm-set-handle-multipart-parameter
 579        mm-security-handle 'gnus-info
 580        (epg-verify-result-to-string (epg-context-result-for context 'verify)))
 581       handle)))
 582
 583 (defun mml-smime-epg-verify-test (handle ctl)
 584   t)
 585
 586 (provide 'mml-smime)
 587
 588 ;;; mml-smime.el ends here