git.chise.org Git - elisp/gnus.git-/blob - lisp/mml2015.el

   1 ;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP)
   2 ;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
   3
   4 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
   5 ;; Keywords: PGP MIME MML
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published
  11 ;; by the Free Software Foundation; either version 2, or (at your
  12 ;; option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful, but
  15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 ;; General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; RFC 2015 is updated by RFC 3156, this file should be compatible
  27 ;; with both.
  28
  29 ;;; Code:
  30
  31 (eval-when-compile (require 'cl))
  32 (eval-when-compile (require 'gnus-clfns))
  33 (require 'mm-decode)
  34
  35 (defvar mml2015-use (or
  36                      (progn
  37                        (ignore-errors
  38                          (require 'gpg))
  39                        (and (fboundp 'gpg-sign-detached)
  40                             'gpg))
  41                      (progn (ignore-errors
  42                               (load "mc-toplev"))
  43                             (and (fboundp 'mc-encrypt-generic)
  44                                  (fboundp 'mc-sign-generic)
  45                                  (fboundp 'mc-cleanup-recipient-headers)
  46                                  'mailcrypt)))
  47   "The package used for PGP/MIME.")
  48
  49 ;; Something is not RFC2015.
  50 (defvar mml2015-function-alist
  51   '((mailcrypt mml2015-mailcrypt-sign
  52                mml2015-mailcrypt-encrypt
  53                mml2015-mailcrypt-verify
  54                mml2015-mailcrypt-decrypt
  55                mml2015-mailcrypt-clear-verify
  56                mml2015-mailcrypt-clear-decrypt)
  57     (gpg mml2015-gpg-sign
  58          mml2015-gpg-encrypt
  59          mml2015-gpg-verify
  60          mml2015-gpg-decrypt
  61          mml2015-gpg-clear-verify
  62          mml2015-gpg-clear-decrypt))
  63   "Alist of PGP/MIME functions.")
  64
  65 (defvar mml2015-result-buffer nil)
  66
  67 (defvar mml2015-trust-boundaries-alist
  68   '((trust-undefined . nil)
  69     (trust-none      . nil)
  70     (trust-marginal  . t)
  71     (trust-full      . t)
  72     (trust-ultimate  . t))
  73   "Trust boundaries for a signer's GnuPG key.
  74 This alist contains pairs of the form (trust-symbol . boolean), with
  75 symbols that are contained in `gpg-unabbrev-trust-alist'. The boolean
  76 specifies whether the given trust value is good enough to be trusted
  77 by you.")
  78
  79 ;;; mailcrypt wrapper
  80
  81 (eval-and-compile
  82   (autoload 'mailcrypt-decrypt "mailcrypt")
  83   (autoload 'mailcrypt-verify "mailcrypt")
  84   (autoload 'mc-pgp-always-sign "mailcrypt")
  85   (autoload 'mc-encrypt-generic "mc-toplev")
  86   (autoload 'mc-cleanup-recipient-headers "mc-toplev")
  87   (autoload 'mc-sign-generic "mc-toplev"))
  88
  89 (eval-when-compile
  90   (defvar mc-default-scheme)
  91   (defvar mc-schemes))
  92
  93 (defvar mml2015-decrypt-function 'mailcrypt-decrypt)
  94 (defvar mml2015-verify-function 'mailcrypt-verify)
  95
  96 (defun mml2015-format-error (err)
  97   (if (stringp (cadr err))
  98       (cadr err)
  99     (format "%S" (cdr err))))
 100
 101 (defun mml2015-mailcrypt-decrypt (handle ctl)
 102   (catch 'error
 103     (let (child handles result)
 104       (unless (setq child (mm-find-part-by-type
 105                            (cdr handle)
 106                            "application/octet-stream" nil t))
 107         (mm-set-handle-multipart-parameter
 108          mm-security-handle 'gnus-info "Corrupted")
 109         (throw 'error handle))
 110       (with-temp-buffer
 111         (mm-insert-part child)
 112         (setq result
 113               (condition-case err
 114                   (funcall mml2015-decrypt-function)
 115                 (error
 116                  (mm-set-handle-multipart-parameter
 117                   mm-security-handle 'gnus-details (mml2015-format-error err))
 118                  nil)
 119                 (quit
 120                  (mm-set-handle-multipart-parameter
 121                   mm-security-handle 'gnus-details "Quit.")
 122                  nil)))
 123         (unless (car result)
 124           (mm-set-handle-multipart-parameter
 125            mm-security-handle 'gnus-info "Failed")
 126           (throw 'error handle))
 127         (setq handles (mm-dissect-buffer t)))
 128       (mm-destroy-parts handle)
 129       (mm-set-handle-multipart-parameter
 130        mm-security-handle 'gnus-info
 131        (concat "OK"
 132                (let ((sig (with-current-buffer mml2015-result-buffer
 133                             (mml2015-gpg-extract-signature-details))))
 134                  (concat ", Signer: " sig))))
 135       (if (listp (car handles))
 136           handles
 137         (list handles)))))
 138
 139 (defun mml2015-mailcrypt-clear-decrypt ()
 140   (let (result)
 141     (setq result
 142           (condition-case err
 143               (funcall mml2015-decrypt-function)
 144             (error
 145              (mm-set-handle-multipart-parameter
 146               mm-security-handle 'gnus-details (mml2015-format-error err))
 147              nil)
 148             (quit
 149              (mm-set-handle-multipart-parameter
 150               mm-security-handle 'gnus-details "Quit.")
 151              nil)))
 152     (if (car result)
 153         (mm-set-handle-multipart-parameter
 154          mm-security-handle 'gnus-info "OK")
 155       (mm-set-handle-multipart-parameter
 156        mm-security-handle 'gnus-info "Failed"))))
 157
 158 (defun mml2015-fix-micalg (alg)
 159   (and alg
 160        ;; Mutt/1.2.5i has seen sending micalg=php-sha1
 161        (upcase (if (string-match "^p[gh]p-" alg)
 162                    (substring alg (match-end 0))
 163                  alg))))
 164
 165 (defun mml2015-mailcrypt-verify (handle ctl)
 166   (catch 'error
 167     (let (part)
 168       (unless (setq part (mm-find-raw-part-by-type
 169                           ctl (or (mm-handle-multipart-ctl-parameter
 170                                    ctl 'protocol)
 171                                   "application/pgp-signature")
 172                           t))
 173         (mm-set-handle-multipart-parameter
 174          mm-security-handle 'gnus-info "Corrupted")
 175         (throw 'error handle))
 176       (with-temp-buffer
 177         (insert "-----BEGIN PGP SIGNED MESSAGE-----\n")
 178         (insert (format "Hash: %s\n\n"
 179                         (or (mml2015-fix-micalg
 180                              (mm-handle-multipart-ctl-parameter
 181                               ctl 'micalg))
 182                             "SHA1")))
 183         (save-restriction
 184           (narrow-to-region (point) (point))
 185           (insert part "\n")
 186           (goto-char (point-min))
 187           (while (not (eobp))
 188             (if (looking-at "^-")
 189                 (insert "- "))
 190             (forward-line)))
 191         (unless (setq part (mm-find-part-by-type
 192                             (cdr handle) "application/pgp-signature" nil t))
 193           (mm-set-handle-multipart-parameter
 194            mm-security-handle 'gnus-info "Corrupted")
 195           (throw 'error handle))
 196         (save-restriction
 197           (narrow-to-region (point) (point))
 198           (mm-insert-part part)
 199           (goto-char (point-min))
 200           (if (re-search-forward "^-----BEGIN PGP [^-]+-----\r?$" nil t)
 201               (replace-match "-----BEGIN PGP SIGNATURE-----" t t))
 202           (if (re-search-forward "^-----END PGP [^-]+-----\r?$" nil t)
 203               (replace-match "-----END PGP SIGNATURE-----" t t)))
 204         (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
 205           (unless (condition-case err
 206                       (prog1
 207                           (funcall mml2015-verify-function)
 208                         (if (get-buffer " *mailcrypt stderr temp")
 209                             (mm-set-handle-multipart-parameter
 210                              mm-security-handle 'gnus-details
 211                              (with-current-buffer " *mailcrypt stderr temp"
 212                                (buffer-string))))
 213                         (if (get-buffer " *mailcrypt stdout temp")
 214                             (kill-buffer " *mailcrypt stdout temp"))
 215                         (if (get-buffer " *mailcrypt stderr temp")
 216                             (kill-buffer " *mailcrypt stderr temp"))
 217                         (if (get-buffer " *mailcrypt status temp")
 218                             (kill-buffer " *mailcrypt status temp"))
 219                         (if (get-buffer mc-gpg-debug-buffer)
 220                             (kill-buffer mc-gpg-debug-buffer)))
 221                     (error
 222                      (mm-set-handle-multipart-parameter
 223                       mm-security-handle 'gnus-details (mml2015-format-error err))
 224                      nil)
 225                     (quit
 226                      (mm-set-handle-multipart-parameter
 227                       mm-security-handle 'gnus-details "Quit.")
 228                      nil))
 229             (mm-set-handle-multipart-parameter
 230              mm-security-handle 'gnus-info "Failed")
 231             (throw 'error handle))))
 232       (mm-set-handle-multipart-parameter
 233        mm-security-handle 'gnus-info "OK")
 234       handle)))
 235
 236 (defun mml2015-mailcrypt-clear-verify ()
 237   (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
 238     (if (condition-case err
 239             (prog1
 240                 (funcall mml2015-verify-function)
 241               (if (get-buffer " *mailcrypt stderr temp")
 242                   (mm-set-handle-multipart-parameter
 243                    mm-security-handle 'gnus-details
 244                    (with-current-buffer " *mailcrypt stderr temp"
 245                      (buffer-string))))
 246               (if (get-buffer " *mailcrypt stdout temp")
 247                   (kill-buffer " *mailcrypt stdout temp"))
 248               (if (get-buffer " *mailcrypt stderr temp")
 249                   (kill-buffer " *mailcrypt stderr temp"))
 250               (if (get-buffer " *mailcrypt status temp")
 251                   (kill-buffer " *mailcrypt status temp"))
 252               (if (get-buffer mc-gpg-debug-buffer)
 253                   (kill-buffer mc-gpg-debug-buffer)))
 254           (error
 255            (mm-set-handle-multipart-parameter
 256             mm-security-handle 'gnus-details (mml2015-format-error err))
 257            nil)
 258           (quit
 259            (mm-set-handle-multipart-parameter
 260             mm-security-handle 'gnus-details "Quit.")
 261            nil))
 262         (mm-set-handle-multipart-parameter
 263          mm-security-handle 'gnus-info "OK")
 264       (mm-set-handle-multipart-parameter
 265        mm-security-handle 'gnus-info "Failed"))))
 266
 267 (defun mml2015-mailcrypt-sign (cont)
 268   (mc-sign-generic (message-options-get 'message-sender)
 269                    nil nil nil nil)
 270   (let ((boundary
 271          (funcall mml-boundary-function (incf mml-multipart-number)))
 272         hash point)
 273     (goto-char (point-min))
 274     (unless (re-search-forward "^-----BEGIN PGP SIGNED MESSAGE-----\r?$" nil t)
 275       (error "Cannot find signed begin line"))
 276     (goto-char (match-beginning 0))
 277     (forward-line 1)
 278     (unless (looking-at "Hash:[ \t]*\\([a-zA-Z0-9]+\\)")
 279       (error "Cannot not find PGP hash"))
 280     (setq hash (match-string 1))
 281     (unless (re-search-forward "^$" nil t)
 282       (error "Cannot not find PGP message"))
 283     (forward-line 1)
 284     (delete-region (point-min) (point))
 285     (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
 286                     boundary))
 287     (insert (format "\tmicalg=pgp-%s; protocol=\"application/pgp-signature\"\n"
 288                     (downcase hash)))
 289     (insert (format "\n--%s\n" boundary))
 290     (setq point (point))
 291     (goto-char (point-max))
 292     (unless (re-search-backward "^-----END PGP SIGNATURE-----\r?$" nil t)
 293       (error "Cannot find signature part"))
 294     (replace-match "-----END PGP MESSAGE-----" t t)
 295     (goto-char (match-beginning 0))
 296     (unless (re-search-backward "^-----BEGIN PGP SIGNATURE-----\r?$"
 297                                 nil t)
 298       (error "Cannot find signature part"))
 299     (replace-match "-----BEGIN PGP MESSAGE-----" t t)
 300     (goto-char (match-beginning 0))
 301     (save-restriction
 302       (narrow-to-region point (point))
 303       (goto-char point)
 304       (while (re-search-forward "^- -" nil t)
 305         (replace-match "-" t t))
 306       (goto-char (point-max)))
 307     (insert (format "--%s\n" boundary))
 308     (insert "Content-Type: application/pgp-signature\n\n")
 309     (goto-char (point-max))
 310     (insert (format "--%s--\n" boundary))
 311     (goto-char (point-max))))
 312
 313 (defun mml2015-mailcrypt-encrypt (cont)
 314   (let ((mc-pgp-always-sign
 315          (or mc-pgp-always-sign
 316              (eq t (or (message-options-get 'message-sign-encrypt)
 317                        (message-options-set
 318                         'message-sign-encrypt
 319                         (or (y-or-n-p "Sign the message? ")
 320                             'not))))
 321              'never)))
 322     (mm-with-unibyte-current-buffer-mule4
 323       (mc-encrypt-generic
 324        (or (message-options-get 'message-recipients)
 325            (message-options-set 'message-recipients
 326                                 (mc-cleanup-recipient-headers
 327                                  (read-string "Recipients: "))))
 328        nil nil nil
 329        (message-options-get 'message-sender))))
 330   (goto-char (point-min))
 331   (unless (looking-at "-----BEGIN PGP MESSAGE-----")
 332     (error "Fail to encrypt the message"))
 333   (let ((boundary
 334          (funcall mml-boundary-function (incf mml-multipart-number))))
 335     (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
 336                     boundary))
 337     (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
 338     (insert (format "--%s\n" boundary))
 339     (insert "Content-Type: application/pgp-encrypted\n\n")
 340     (insert "Version: 1\n\n")
 341     (insert (format "--%s\n" boundary))
 342     (insert "Content-Type: application/octet-stream\n\n")
 343     (goto-char (point-max))
 344     (insert (format "--%s--\n" boundary))
 345     (goto-char (point-max))))
 346
 347 ;;; gpg wrapper
 348
 349 (eval-and-compile
 350   (autoload 'gpg-decrypt "gpg")
 351   (autoload 'gpg-verify "gpg")
 352   (autoload 'gpg-verify-cleartext "gpg")
 353   (autoload 'gpg-sign-detached "gpg")
 354   (autoload 'gpg-sign-encrypt "gpg")
 355   (autoload 'gpg-passphrase-read "gpg"))
 356
 357 (defun mml2015-gpg-passphrase ()
 358   (or (message-options-get 'gpg-passphrase)
 359       (message-options-set 'gpg-passphrase (gpg-passphrase-read))))
 360
 361 (defun mml2015-gpg-decrypt-1 ()
 362   (let ((cipher (current-buffer)) plain result)
 363     (if (with-temp-buffer
 364           (prog1
 365               (gpg-decrypt cipher (setq plain (current-buffer))
 366                            mml2015-result-buffer nil)
 367             (mm-set-handle-multipart-parameter
 368              mm-security-handle 'gnus-details
 369              (with-current-buffer mml2015-result-buffer
 370                (buffer-string)))
 371             (set-buffer cipher)
 372             (erase-buffer)
 373             (insert-buffer plain)
 374             (goto-char (point-min))
 375             (while (search-forward "\r\n" nil t)
 376               (replace-match "\n" t t))))
 377         '(t)
 378       ;; Some wrong with the return value, check plain text buffer.
 379       (if (> (point-max) (point-min))
 380           '(t)
 381         nil))))
 382
 383 (defun mml2015-gpg-decrypt (handle ctl)
 384   (let ((mml2015-decrypt-function 'mml2015-gpg-decrypt-1))
 385     (mml2015-mailcrypt-decrypt handle ctl)))
 386
 387 (defun mml2015-gpg-clear-decrypt ()
 388   (let (result)
 389     (setq result (mml2015-gpg-decrypt-1))
 390     (if (car result)
 391         (mm-set-handle-multipart-parameter
 392          mm-security-handle 'gnus-info "OK")
 393       (mm-set-handle-multipart-parameter
 394        mm-security-handle 'gnus-info "Failed"))))
 395
 396 (defun mml2015-gpg-pretty-print-fpr (fingerprint)
 397   (let* ((result "")
 398          (fpr-length (string-width fingerprint))
 399          (n-slice 0)
 400          slice)
 401     (setq fingerprint (string-to-list fingerprint))
 402     (while fingerprint
 403       (setq fpr-length (- fpr-length 4))
 404       (setq slice (butlast fingerprint fpr-length))
 405       (setq fingerprint (nthcdr 4 fingerprint))
 406       (setq n-slice (1+ n-slice))
 407       (setq result
 408             (concat
 409              result
 410              (case n-slice
 411                (1  slice)
 412                (otherwise (concat " " slice))))))
 413     result))
 414
 415 (defun mml2015-gpg-extract-signature-details ()
 416   (goto-char (point-min))
 417   (if (boundp 'gpg-unabbrev-trust-alist)
 418       (let* ((signer (and (re-search-forward
 419                            "^\\[GNUPG:\\] GOODSIG [0-9A-Za-z]* \\(.*\\)$"
 420                            nil t)
 421                           (match-string 1)))
 422              (fprint (and (re-search-forward
 423                            "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) "
 424                        nil t)
 425                           (match-string 1)))
 426              (trust  (and (re-search-forward "^\\[GNUPG:\\] \\(TRUST_.*\\)$" nil t)
 427                           (match-string 1)))
 428              (trust-good-enough-p
 429               (cdr (assoc (cdr (assoc trust gpg-unabbrev-trust-alist))
 430                       mml2015-trust-boundaries-alist))))
 431         (if (and signer trust fprint)
 432             (concat signer
 433                     (unless trust-good-enough-p
 434                       (concat "\nUntrusted, Fingerprint: "
 435                               (mml2015-gpg-pretty-print-fpr fprint))))
 436           "From unknown user"))
 437     (if (re-search-forward "^gpg: Good signature from \"\\(.*\\)\"$" nil t)
 438         (match-string 1)
 439       "From unknown user")))
 440
 441 (defun mml2015-gpg-verify (handle ctl)
 442   (catch 'error
 443     (let (part message signature info-is-set-p)
 444       (unless (setq part (mm-find-raw-part-by-type
 445                           ctl (or (mm-handle-multipart-ctl-parameter
 446                                    ctl 'protocol)
 447                                   "application/pgp-signature")
 448                           t))
 449         (mm-set-handle-multipart-parameter
 450          mm-security-handle 'gnus-info "Corrupted")
 451         (throw 'error handle))
 452       (with-temp-buffer
 453         (setq message (current-buffer))
 454         (insert part)
 455         ;; Convert <LF> to <CR><LF> in verify mode.  Sign and
 456         ;; clearsign use --textmode. The conversion is not necessary.
 457         ;; In clearverify, the conversion is not necessary either.
 458         (goto-char (point-min))
 459         (end-of-line)
 460         (while (not (eobp))
 461           (unless (eq (char-before) ?\r)
 462             (insert "\r"))
 463           (forward-line)
 464           (end-of-line))
 465         (with-temp-buffer
 466           (setq signature (current-buffer))
 467           (unless (setq part (mm-find-part-by-type
 468                               (cdr handle) "application/pgp-signature" nil t))
 469             (mm-set-handle-multipart-parameter
 470              mm-security-handle 'gnus-info "Corrupted")
 471             (throw 'error handle))
 472           (mm-insert-part part)
 473           (unless (condition-case err
 474                       (prog1
 475                           (gpg-verify message signature mml2015-result-buffer)
 476                         (mm-set-handle-multipart-parameter
 477                          mm-security-handle 'gnus-details
 478                          (with-current-buffer mml2015-result-buffer
 479                            (buffer-string))))
 480                     (error
 481                      (mm-set-handle-multipart-parameter
 482                       mm-security-handle 'gnus-details (mml2015-format-error err))
 483                      (mm-set-handle-multipart-parameter
 484                       mm-security-handle 'gnus-info "Error.")
 485                      (setq info-is-set-p t)
 486                      nil)
 487                     (quit
 488                      (mm-set-handle-multipart-parameter
 489                       mm-security-handle 'gnus-details "Quit.")
 490                      (mm-set-handle-multipart-parameter
 491                       mm-security-handle 'gnus-info "Quit.")
 492                      (setq info-is-set-p t)
 493                      nil))
 494             (unless info-is-set-p
 495               (mm-set-handle-multipart-parameter
 496                mm-security-handle 'gnus-info "Failed"))
 497             (throw 'error handle)))
 498         (mm-set-handle-multipart-parameter
 499          mm-security-handle 'gnus-info
 500          (with-current-buffer mml2015-result-buffer
 501            (mml2015-gpg-extract-signature-details))))
 502       handle)))
 503
 504 (defun mml2015-gpg-clear-verify ()
 505   (if (condition-case err
 506           (prog1
 507               (gpg-verify-cleartext (current-buffer) mml2015-result-buffer)
 508             (mm-set-handle-multipart-parameter
 509              mm-security-handle 'gnus-details
 510              (with-current-buffer mml2015-result-buffer
 511                (buffer-string))))
 512         (error
 513          (mm-set-handle-multipart-parameter
 514           mm-security-handle 'gnus-details (mml2015-format-error err))
 515          nil)
 516         (quit
 517          (mm-set-handle-multipart-parameter
 518           mm-security-handle 'gnus-details "Quit.")
 519          nil))
 520       (mm-set-handle-multipart-parameter
 521        mm-security-handle 'gnus-info
 522        (with-current-buffer mml2015-result-buffer
 523          (mml2015-gpg-extract-signature-details)))
 524     (mm-set-handle-multipart-parameter
 525      mm-security-handle 'gnus-info "Failed")))
 526
 527 (defun mml2015-gpg-sign (cont)
 528   (let ((boundary
 529          (funcall mml-boundary-function (incf mml-multipart-number)))
 530         (text (current-buffer)) signature)
 531     (goto-char (point-max))
 532     (unless (bolp)
 533       (insert "\n"))
 534     (with-temp-buffer
 535       (unless (gpg-sign-detached text (setq signature (current-buffer))
 536                                  mml2015-result-buffer
 537                                  nil
 538                                  (message-options-get 'message-sender)
 539                                  t t) ; armor & textmode
 540         (unless (> (point-max) (point-min))
 541           (pop-to-buffer mml2015-result-buffer)
 542           (error "Sign error")))
 543       (goto-char (point-min))
 544       (while (re-search-forward "\r+$" nil t)
 545         (replace-match "" t t))
 546       (set-buffer text)
 547       (goto-char (point-min))
 548       (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
 549                       boundary))
 550       ;;; FIXME: what is the micalg?
 551       (insert "\tmicalg=pgp-sha1; protocol=\"application/pgp-signature\"\n")
 552       (insert (format "\n--%s\n" boundary))
 553       (goto-char (point-max))
 554       (insert (format "\n--%s\n" boundary))
 555       (insert "Content-Type: application/pgp-signature\n\n")
 556       (insert-buffer signature)
 557       (goto-char (point-max))
 558       (insert (format "--%s--\n" boundary))
 559       (goto-char (point-max)))))
 560
 561 (defun mml2015-gpg-encrypt (cont)
 562   (let ((boundary
 563          (funcall mml-boundary-function (incf mml-multipart-number)))
 564         (text (current-buffer))
 565         cipher)
 566     (mm-with-unibyte-current-buffer-mule4
 567       (with-temp-buffer
 568         (unless (gpg-sign-encrypt
 569                  text (setq cipher (current-buffer))
 570                  mml2015-result-buffer
 571                  (split-string
 572                   (or
 573                    (message-options-get 'message-recipients)
 574                    (message-options-set 'message-recipients
 575                                         (read-string "Recipients: ")))
 576                   "[ \f\t\n\r\v,]+")
 577                  nil
 578                  (message-options-get 'message-sender)
 579                  t t) ; armor & textmode
 580           (unless (> (point-max) (point-min))
 581             (pop-to-buffer mml2015-result-buffer)
 582             (error "Encrypt error")))
 583         (goto-char (point-min))
 584         (while (re-search-forward "\r+$" nil t)
 585           (replace-match "" t t))
 586         (set-buffer text)
 587         (delete-region (point-min) (point-max))
 588         (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
 589                         boundary))
 590         (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
 591         (insert (format "--%s\n" boundary))
 592         (insert "Content-Type: application/pgp-encrypted\n\n")
 593         (insert "Version: 1\n\n")
 594         (insert (format "--%s\n" boundary))
 595         (insert "Content-Type: application/octet-stream\n\n")
 596         (insert-buffer cipher)
 597         (goto-char (point-max))
 598         (insert (format "--%s--\n" boundary))
 599         (goto-char (point-max))))))
 600
 601 ;;; General wrapper
 602
 603 (defun mml2015-clean-buffer ()
 604   (if (gnus-buffer-live-p mml2015-result-buffer)
 605       (with-current-buffer mml2015-result-buffer
 606         (erase-buffer)
 607         t)
 608     (setq mml2015-result-buffer
 609           (gnus-get-buffer-create "*MML2015 Result*"))
 610     nil))
 611
 612 (defsubst mml2015-clear-decrypt-function ()
 613   (nth 6 (assq mml2015-use mml2015-function-alist)))
 614
 615 (defsubst mml2015-clear-verify-function ()
 616   (nth 5 (assq mml2015-use mml2015-function-alist)))
 617
 618 ;;;###autoload
 619 (defun mml2015-decrypt (handle ctl)
 620   (mml2015-clean-buffer)
 621   (let ((func (nth 4 (assq mml2015-use mml2015-function-alist))))
 622     (if func
 623         (funcall func handle ctl)
 624       handle)))
 625
 626 ;;;###autoload
 627 (defun mml2015-decrypt-test (handle ctl)
 628   mml2015-use)
 629
 630 ;;;###autoload
 631 (defun mml2015-verify (handle ctl)
 632   (mml2015-clean-buffer)
 633   (let ((func (nth 3 (assq mml2015-use mml2015-function-alist))))
 634     (if func
 635         (funcall func handle ctl)
 636       handle)))
 637
 638 ;;;###autoload
 639 (defun mml2015-verify-test (handle ctl)
 640   mml2015-use)
 641
 642 ;;;###autoload
 643 (defun mml2015-encrypt (cont)
 644   (mml2015-clean-buffer)
 645   (let ((func (nth 2 (assq mml2015-use mml2015-function-alist))))
 646     (if func
 647         (funcall func cont)
 648       (error "Cannot find encrypt function"))))
 649
 650 ;;;###autoload
 651 (defun mml2015-sign (cont)
 652   (mml2015-clean-buffer)
 653   (let ((func (nth 1 (assq mml2015-use mml2015-function-alist))))
 654     (if func
 655         (funcall func cont)
 656       (error "Cannot find sign function"))))
 657
 658 ;;;###autoload
 659 (defun mml2015-self-encrypt ()
 660   (mml2015-encrypt nil))
 661
 662 (provide 'mml2015)
 663
 664 ;;; mml2015.el ends here