code.delx.au - gnu-emacs/blob - lisp/gnus/mml-smime.el

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