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