annotate lisp/gnus/mml2015.el @ 88242:a64eb026ac9e

*** empty log message ***
author Henrik Enberg <henrik.enberg@telia.com>
date Fri, 20 Jan 2006 18:50:02 +0000
parents d7ddb3e565de
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
88155
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
1 ;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
2
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
4 ;; 2005 Free Software Foundation, Inc.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
5
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
6 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
7 ;; Keywords: PGP MIME MML
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
8
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
9 ;; This file is part of GNU Emacs.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
10
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
12 ;; it under the terms of the GNU General Public License as published
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
13 ;; by the Free Software Foundation; either version 2, or (at your
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
14 ;; option) any later version.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
15
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
16 ;; GNU Emacs is distributed in the hope that it will be useful, but
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
19 ;; General Public License for more details.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
20
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
21 ;; You should have received a copy of the GNU General Public License
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
24 ;; Boston, MA 02110-1301, USA.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
25
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
26 ;;; Commentary:
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
27
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
28 ;; RFC 2015 is updated by RFC 3156, this file should be compatible
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
29 ;; with both.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
30
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
31 ;;; Code:
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
32
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
33 (eval-when-compile (require 'cl))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
34 (require 'mm-decode)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
35 (require 'mm-util)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
36 (require 'mml)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
37
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
38 (defvar mc-pgp-always-sign)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
39
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
40 (defvar mml2015-use (or
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
41 (progn
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
42 (ignore-errors
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
43 (require 'pgg))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
44 (and (fboundp 'pgg-sign-region)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
45 'pgg))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
46 (progn
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
47 (ignore-errors
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
48 (require 'gpg))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
49 (and (fboundp 'gpg-sign-detached)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
50 'gpg))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
51 (progn (ignore-errors
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
52 (load "mc-toplev"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
53 (and (fboundp 'mc-encrypt-generic)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
54 (fboundp 'mc-sign-generic)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
55 (fboundp 'mc-cleanup-recipient-headers)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
56 'mailcrypt)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
57 "The package used for PGP/MIME.")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
58
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
59 ;; Something is not RFC2015.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
60 (defvar mml2015-function-alist
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
61 '((mailcrypt mml2015-mailcrypt-sign
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
62 mml2015-mailcrypt-encrypt
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
63 mml2015-mailcrypt-verify
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
64 mml2015-mailcrypt-decrypt
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
65 mml2015-mailcrypt-clear-verify
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
66 mml2015-mailcrypt-clear-decrypt)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
67 (gpg mml2015-gpg-sign
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
68 mml2015-gpg-encrypt
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
69 mml2015-gpg-verify
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
70 mml2015-gpg-decrypt
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
71 mml2015-gpg-clear-verify
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
72 mml2015-gpg-clear-decrypt)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
73 (pgg mml2015-pgg-sign
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
74 mml2015-pgg-encrypt
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
75 mml2015-pgg-verify
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
76 mml2015-pgg-decrypt
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
77 mml2015-pgg-clear-verify
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
78 mml2015-pgg-clear-decrypt))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
79 "Alist of PGP/MIME functions.")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
80
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
81 (defvar mml2015-result-buffer nil)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
82
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
83 (defcustom mml2015-unabbrev-trust-alist
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
84 '(("TRUST_UNDEFINED" . nil)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
85 ("TRUST_NEVER" . nil)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
86 ("TRUST_MARGINAL" . t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
87 ("TRUST_FULLY" . t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
88 ("TRUST_ULTIMATE" . t))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
89 "Map GnuPG trust output values to a boolean saying if you trust the key."
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
90 :version "22.1"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
91 :group 'mime-security
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
92 :type '(repeat (cons (regexp :tag "GnuPG output regexp")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
93 (boolean :tag "Trust key"))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
94
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
95 ;;; mailcrypt wrapper
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
96
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
97 (eval-and-compile
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
98 (autoload 'mailcrypt-decrypt "mailcrypt")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
99 (autoload 'mailcrypt-verify "mailcrypt")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
100 (autoload 'mc-pgp-always-sign "mailcrypt")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
101 (autoload 'mc-encrypt-generic "mc-toplev")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
102 (autoload 'mc-cleanup-recipient-headers "mc-toplev")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
103 (autoload 'mc-sign-generic "mc-toplev"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
104
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
105 (eval-when-compile
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
106 (defvar mc-default-scheme)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
107 (defvar mc-schemes))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
108
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
109 (defvar mml2015-decrypt-function 'mailcrypt-decrypt)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
110 (defvar mml2015-verify-function 'mailcrypt-verify)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
111
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
112 (defun mml2015-format-error (err)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
113 (if (stringp (cadr err))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
114 (cadr err)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
115 (format "%S" (cdr err))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
116
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
117 (defun mml2015-mailcrypt-decrypt (handle ctl)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
118 (catch 'error
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
119 (let (child handles result)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
120 (unless (setq child (mm-find-part-by-type
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
121 (cdr handle)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
122 "application/octet-stream" nil t))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
123 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
124 mm-security-handle 'gnus-info "Corrupted")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
125 (throw 'error handle))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
126 (with-temp-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
127 (mm-insert-part child)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
128 (setq result
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
129 (condition-case err
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
130 (funcall mml2015-decrypt-function)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
131 (error
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
132 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
133 mm-security-handle 'gnus-details (mml2015-format-error err))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
134 nil)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
135 (quit
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
136 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
137 mm-security-handle 'gnus-details "Quit.")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
138 nil)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
139 (unless (car result)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
140 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
141 mm-security-handle 'gnus-info "Failed")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
142 (throw 'error handle))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
143 (setq handles (mm-dissect-buffer t)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
144 (mm-destroy-parts handle)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
145 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
146 mm-security-handle 'gnus-info
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
147 (concat "OK"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
148 (let ((sig (with-current-buffer mml2015-result-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
149 (mml2015-gpg-extract-signature-details))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
150 (concat ", Signer: " sig))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
151 (if (listp (car handles))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
152 handles
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
153 (list handles)))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
154
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
155 (defun mml2015-mailcrypt-clear-decrypt ()
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
156 (let (result)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
157 (setq result
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
158 (condition-case err
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
159 (funcall mml2015-decrypt-function)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
160 (error
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
161 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
162 mm-security-handle 'gnus-details (mml2015-format-error err))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
163 nil)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
164 (quit
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
165 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
166 mm-security-handle 'gnus-details "Quit.")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
167 nil)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
168 (if (car result)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
169 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
170 mm-security-handle 'gnus-info "OK")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
171 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
172 mm-security-handle 'gnus-info "Failed"))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
173
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
174 (defun mml2015-fix-micalg (alg)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
175 (and alg
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
176 ;; Mutt/1.2.5i has seen sending micalg=php-sha1
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
177 (upcase (if (string-match "^p[gh]p-" alg)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
178 (substring alg (match-end 0))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
179 alg))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
180
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
181 (defun mml2015-mailcrypt-verify (handle ctl)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
182 (catch 'error
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
183 (let (part)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
184 (unless (setq part (mm-find-raw-part-by-type
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
185 ctl (or (mm-handle-multipart-ctl-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
186 ctl 'protocol)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
187 "application/pgp-signature")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
188 t))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
189 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
190 mm-security-handle 'gnus-info "Corrupted")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
191 (throw 'error handle))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
192 (with-temp-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
193 (insert "-----BEGIN PGP SIGNED MESSAGE-----\n")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
194 (insert (format "Hash: %s\n\n"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
195 (or (mml2015-fix-micalg
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
196 (mm-handle-multipart-ctl-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
197 ctl 'micalg))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
198 "SHA1")))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
199 (save-restriction
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
200 (narrow-to-region (point) (point))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
201 (insert part "\n")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
202 (goto-char (point-min))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
203 (while (not (eobp))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
204 (if (looking-at "^-")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
205 (insert "- "))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
206 (forward-line)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
207 (unless (setq part (mm-find-part-by-type
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
208 (cdr handle) "application/pgp-signature" nil t))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
209 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
210 mm-security-handle 'gnus-info "Corrupted")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
211 (throw 'error handle))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
212 (save-restriction
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
213 (narrow-to-region (point) (point))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
214 (mm-insert-part part)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
215 (goto-char (point-min))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
216 (if (re-search-forward "^-----BEGIN PGP [^-]+-----\r?$" nil t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
217 (replace-match "-----BEGIN PGP SIGNATURE-----" t t))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
218 (if (re-search-forward "^-----END PGP [^-]+-----\r?$" nil t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
219 (replace-match "-----END PGP SIGNATURE-----" t t)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
220 (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
221 (unless (condition-case err
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
222 (prog1
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
223 (funcall mml2015-verify-function)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
224 (if (get-buffer " *mailcrypt stderr temp")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
225 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
226 mm-security-handle 'gnus-details
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
227 (with-current-buffer " *mailcrypt stderr temp"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
228 (buffer-string))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
229 (if (get-buffer " *mailcrypt stdout temp")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
230 (kill-buffer " *mailcrypt stdout temp"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
231 (if (get-buffer " *mailcrypt stderr temp")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
232 (kill-buffer " *mailcrypt stderr temp"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
233 (if (get-buffer " *mailcrypt status temp")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
234 (kill-buffer " *mailcrypt status temp"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
235 (if (get-buffer mc-gpg-debug-buffer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
236 (kill-buffer mc-gpg-debug-buffer)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
237 (error
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
238 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
239 mm-security-handle 'gnus-details (mml2015-format-error err))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
240 nil)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
241 (quit
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
242 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
243 mm-security-handle 'gnus-details "Quit.")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
244 nil))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
245 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
246 mm-security-handle 'gnus-info "Failed")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
247 (throw 'error handle))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
248 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
249 mm-security-handle 'gnus-info "OK")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
250 handle)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
251
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
252 (defun mml2015-mailcrypt-clear-verify ()
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
253 (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
254 (if (condition-case err
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
255 (prog1
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
256 (funcall mml2015-verify-function)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
257 (if (get-buffer " *mailcrypt stderr temp")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
258 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
259 mm-security-handle 'gnus-details
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
260 (with-current-buffer " *mailcrypt stderr temp"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
261 (buffer-string))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
262 (if (get-buffer " *mailcrypt stdout temp")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
263 (kill-buffer " *mailcrypt stdout temp"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
264 (if (get-buffer " *mailcrypt stderr temp")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
265 (kill-buffer " *mailcrypt stderr temp"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
266 (if (get-buffer " *mailcrypt status temp")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
267 (kill-buffer " *mailcrypt status temp"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
268 (if (get-buffer mc-gpg-debug-buffer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
269 (kill-buffer mc-gpg-debug-buffer)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
270 (error
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
271 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
272 mm-security-handle 'gnus-details (mml2015-format-error err))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
273 nil)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
274 (quit
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
275 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
276 mm-security-handle 'gnus-details "Quit.")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
277 nil))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
278 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
279 mm-security-handle 'gnus-info "OK")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
280 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
281 mm-security-handle 'gnus-info "Failed"))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
282
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
283 (defun mml2015-mailcrypt-sign (cont)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
284 (mc-sign-generic (message-options-get 'message-sender)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
285 nil nil nil nil)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
286 (let ((boundary (mml-compute-boundary cont))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
287 hash point)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
288 (goto-char (point-min))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
289 (unless (re-search-forward "^-----BEGIN PGP SIGNED MESSAGE-----\r?$" nil t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
290 (error "Cannot find signed begin line"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
291 (goto-char (match-beginning 0))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
292 (forward-line 1)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
293 (unless (looking-at "Hash:[ \t]*\\([a-zA-Z0-9]+\\)")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
294 (error "Cannot not find PGP hash"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
295 (setq hash (match-string 1))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
296 (unless (re-search-forward "^$" nil t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
297 (error "Cannot not find PGP message"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
298 (forward-line 1)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
299 (delete-region (point-min) (point))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
300 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
301 boundary))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
302 (insert (format "\tmicalg=pgp-%s; protocol=\"application/pgp-signature\"\n"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
303 (downcase hash)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
304 (insert (format "\n--%s\n" boundary))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
305 (setq point (point))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
306 (goto-char (point-max))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
307 (unless (re-search-backward "^-----END PGP SIGNATURE-----\r?$" nil t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
308 (error "Cannot find signature part"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
309 (replace-match "-----END PGP MESSAGE-----" t t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
310 (goto-char (match-beginning 0))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
311 (unless (re-search-backward "^-----BEGIN PGP SIGNATURE-----\r?$"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
312 nil t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
313 (error "Cannot find signature part"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
314 (replace-match "-----BEGIN PGP MESSAGE-----" t t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
315 (goto-char (match-beginning 0))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
316 (save-restriction
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
317 (narrow-to-region point (point))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
318 (goto-char point)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
319 (while (re-search-forward "^- -" nil t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
320 (replace-match "-" t t))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
321 (goto-char (point-max)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
322 (insert (format "--%s\n" boundary))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
323 (insert "Content-Type: application/pgp-signature\n\n")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
324 (goto-char (point-max))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
325 (insert (format "--%s--\n" boundary))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
326 (goto-char (point-max))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
327
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
328 (defun mml2015-mailcrypt-encrypt (cont &optional sign)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
329 (let ((mc-pgp-always-sign
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
330 (or mc-pgp-always-sign
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
331 sign
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
332 (eq t (or (message-options-get 'message-sign-encrypt)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
333 (message-options-set
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
334 'message-sign-encrypt
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
335 (or (y-or-n-p "Sign the message? ")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
336 'not))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
337 'never)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
338 (mm-with-unibyte-current-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
339 (mc-encrypt-generic
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
340 (or (message-options-get 'message-recipients)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
341 (message-options-set 'message-recipients
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
342 (mc-cleanup-recipient-headers
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
343 (read-string "Recipients: "))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
344 nil nil nil
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
345 (message-options-get 'message-sender))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
346 (goto-char (point-min))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
347 (unless (looking-at "-----BEGIN PGP MESSAGE-----")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
348 (error "Fail to encrypt the message"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
349 (let ((boundary (mml-compute-boundary cont)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
350 (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
351 boundary))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
352 (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
353 (insert (format "--%s\n" boundary))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
354 (insert "Content-Type: application/pgp-encrypted\n\n")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
355 (insert "Version: 1\n\n")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
356 (insert (format "--%s\n" boundary))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
357 (insert "Content-Type: application/octet-stream\n\n")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
358 (goto-char (point-max))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
359 (insert (format "--%s--\n" boundary))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
360 (goto-char (point-max))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
361
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
362 ;;; gpg wrapper
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
363
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
364 (eval-and-compile
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
365 (autoload 'gpg-decrypt "gpg")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
366 (autoload 'gpg-verify "gpg")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
367 (autoload 'gpg-verify-cleartext "gpg")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
368 (autoload 'gpg-sign-detached "gpg")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
369 (autoload 'gpg-sign-encrypt "gpg")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
370 (autoload 'gpg-encrypt "gpg")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
371 (autoload 'gpg-passphrase-read "gpg"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
372
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
373 (defun mml2015-gpg-passphrase ()
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
374 (or (message-options-get 'gpg-passphrase)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
375 (message-options-set 'gpg-passphrase (gpg-passphrase-read))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
376
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
377 (defun mml2015-gpg-decrypt-1 ()
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
378 (let ((cipher (current-buffer)) plain result)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
379 (if (with-temp-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
380 (prog1
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
381 (gpg-decrypt cipher (setq plain (current-buffer))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
382 mml2015-result-buffer nil)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
383 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
384 mm-security-handle 'gnus-details
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
385 (with-current-buffer mml2015-result-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
386 (buffer-string)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
387 (set-buffer cipher)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
388 (erase-buffer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
389 (insert-buffer-substring plain)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
390 (goto-char (point-min))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
391 (while (search-forward "\r\n" nil t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
392 (replace-match "\n" t t))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
393 '(t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
394 ;; Some wrong with the return value, check plain text buffer.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
395 (if (> (point-max) (point-min))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
396 '(t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
397 nil))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
398
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
399 (defun mml2015-gpg-decrypt (handle ctl)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
400 (let ((mml2015-decrypt-function 'mml2015-gpg-decrypt-1))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
401 (mml2015-mailcrypt-decrypt handle ctl)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
402
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
403 (defun mml2015-gpg-clear-decrypt ()
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
404 (let (result)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
405 (setq result (mml2015-gpg-decrypt-1))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
406 (if (car result)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
407 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
408 mm-security-handle 'gnus-info "OK")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
409 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
410 mm-security-handle 'gnus-info "Failed"))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
411
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
412 (defun mml2015-gpg-pretty-print-fpr (fingerprint)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
413 (let* ((result "")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
414 (fpr-length (string-width fingerprint))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
415 (n-slice 0)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
416 slice)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
417 (setq fingerprint (string-to-list fingerprint))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
418 (while fingerprint
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
419 (setq fpr-length (- fpr-length 4))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
420 (setq slice (butlast fingerprint fpr-length))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
421 (setq fingerprint (nthcdr 4 fingerprint))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
422 (setq n-slice (1+ n-slice))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
423 (setq result
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
424 (concat
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
425 result
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
426 (case n-slice
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
427 (1 slice)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
428 (otherwise (concat " " slice))))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
429 result))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
430
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
431 (defun mml2015-gpg-extract-signature-details ()
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
432 (goto-char (point-min))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
433 (let* ((expired (re-search-forward
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
434 "^\\[GNUPG:\\] SIGEXPIRED$"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
435 nil t))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
436 (signer (and (re-search-forward
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
437 "^\\[GNUPG:\\] GOODSIG \\([0-9A-Za-z]*\\) \\(.*\\)$"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
438 nil t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
439 (cons (match-string 1) (match-string 2))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
440 (fprint (and (re-search-forward
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
441 "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) "
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
442 nil t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
443 (match-string 1)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
444 (trust (and (re-search-forward
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
445 "^\\[GNUPG:\\] \\(TRUST_.*\\)$"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
446 nil t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
447 (match-string 1)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
448 (trust-good-enough-p
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
449 (cdr (assoc trust mml2015-unabbrev-trust-alist))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
450 (cond ((and signer fprint)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
451 (concat (cdr signer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
452 (unless trust-good-enough-p
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
453 (concat "\nUntrusted, Fingerprint: "
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
454 (mml2015-gpg-pretty-print-fpr fprint)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
455 (when expired
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
456 (format "\nWARNING: Signature from expired key (%s)"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
457 (car signer)))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
458 ((re-search-forward
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
459 "^\\(gpg: \\)?Good signature from \"\\(.*\\)\"$" nil t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
460 (match-string 2))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
461 (t
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
462 "From unknown user"))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
463
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
464 (defun mml2015-gpg-verify (handle ctl)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
465 (catch 'error
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
466 (let (part message signature info-is-set-p)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
467 (unless (setq part (mm-find-raw-part-by-type
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
468 ctl (or (mm-handle-multipart-ctl-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
469 ctl 'protocol)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
470 "application/pgp-signature")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
471 t))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
472 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
473 mm-security-handle 'gnus-info "Corrupted")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
474 (throw 'error handle))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
475 (with-temp-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
476 (setq message (current-buffer))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
477 (insert part)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
478 ;; Convert <LF> to <CR><LF> in verify mode. Sign and
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
479 ;; clearsign use --textmode. The conversion is not necessary.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
480 ;; In clearverify, the conversion is not necessary either.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
481 (goto-char (point-min))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
482 (end-of-line)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
483 (while (not (eobp))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
484 (unless (eq (char-before) ?\r)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
485 (insert "\r"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
486 (forward-line)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
487 (end-of-line))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
488 (with-temp-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
489 (setq signature (current-buffer))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
490 (unless (setq part (mm-find-part-by-type
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
491 (cdr handle) "application/pgp-signature" nil t))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
492 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
493 mm-security-handle 'gnus-info "Corrupted")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
494 (throw 'error handle))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
495 (mm-insert-part part)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
496 (unless (condition-case err
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
497 (prog1
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
498 (gpg-verify message signature mml2015-result-buffer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
499 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
500 mm-security-handle 'gnus-details
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
501 (with-current-buffer mml2015-result-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
502 (buffer-string))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
503 (error
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
504 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
505 mm-security-handle 'gnus-details (mml2015-format-error err))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
506 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
507 mm-security-handle 'gnus-info "Error.")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
508 (setq info-is-set-p t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
509 nil)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
510 (quit
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
511 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
512 mm-security-handle 'gnus-details "Quit.")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
513 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
514 mm-security-handle 'gnus-info "Quit.")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
515 (setq info-is-set-p t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
516 nil))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
517 (unless info-is-set-p
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
518 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
519 mm-security-handle 'gnus-info "Failed"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
520 (throw 'error handle)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
521 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
522 mm-security-handle 'gnus-info
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
523 (with-current-buffer mml2015-result-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
524 (mml2015-gpg-extract-signature-details))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
525 handle)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
526
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
527 (defun mml2015-gpg-clear-verify ()
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
528 (if (condition-case err
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
529 (prog1
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
530 (gpg-verify-cleartext (current-buffer) mml2015-result-buffer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
531 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
532 mm-security-handle 'gnus-details
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
533 (with-current-buffer mml2015-result-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
534 (buffer-string))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
535 (error
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
536 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
537 mm-security-handle 'gnus-details (mml2015-format-error err))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
538 nil)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
539 (quit
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
540 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
541 mm-security-handle 'gnus-details "Quit.")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
542 nil))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
543 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
544 mm-security-handle 'gnus-info
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
545 (with-current-buffer mml2015-result-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
546 (mml2015-gpg-extract-signature-details)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
547 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
548 mm-security-handle 'gnus-info "Failed")))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
549
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
550 (defun mml2015-gpg-sign (cont)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
551 (let ((boundary (mml-compute-boundary cont))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
552 (text (current-buffer)) signature)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
553 (goto-char (point-max))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
554 (unless (bolp)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
555 (insert "\n"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
556 (with-temp-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
557 (unless (gpg-sign-detached text (setq signature (current-buffer))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
558 mml2015-result-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
559 nil
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
560 (message-options-get 'message-sender)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
561 t t) ; armor & textmode
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
562 (unless (> (point-max) (point-min))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
563 (pop-to-buffer mml2015-result-buffer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
564 (error "Sign error")))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
565 (goto-char (point-min))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
566 (while (re-search-forward "\r+$" nil t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
567 (replace-match "" t t))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
568 (set-buffer text)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
569 (goto-char (point-min))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
570 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
571 boundary))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
572 ;;; FIXME: what is the micalg?
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
573 (insert "\tmicalg=pgp-sha1; protocol=\"application/pgp-signature\"\n")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
574 (insert (format "\n--%s\n" boundary))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
575 (goto-char (point-max))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
576 (insert (format "\n--%s\n" boundary))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
577 (insert "Content-Type: application/pgp-signature\n\n")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
578 (insert-buffer-substring signature)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
579 (goto-char (point-max))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
580 (insert (format "--%s--\n" boundary))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
581 (goto-char (point-max)))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
582
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
583 (defun mml2015-gpg-encrypt (cont &optional sign)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
584 (let ((boundary (mml-compute-boundary cont))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
585 (text (current-buffer))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
586 cipher)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
587 (mm-with-unibyte-current-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
588 (with-temp-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
589 ;; set up a function to call the correct gpg encrypt routine
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
590 ;; with the right arguments. (FIXME: this should be done
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
591 ;; differently.)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
592 (flet ((gpg-encrypt-func
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
593 (sign plaintext ciphertext result recipients &optional
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
594 passphrase sign-with-key armor textmode)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
595 (if sign
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
596 (gpg-sign-encrypt
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
597 plaintext ciphertext result recipients passphrase
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
598 sign-with-key armor textmode)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
599 (gpg-encrypt
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
600 plaintext ciphertext result recipients passphrase
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
601 armor textmode))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
602 (unless (gpg-encrypt-func
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
603 sign ; passed in when using signencrypt
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
604 text (setq cipher (current-buffer))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
605 mml2015-result-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
606 (split-string
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
607 (or
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
608 (message-options-get 'message-recipients)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
609 (message-options-set 'message-recipients
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
610 (read-string "Recipients: ")))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
611 "[ \f\t\n\r\v,]+")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
612 nil
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
613 (message-options-get 'message-sender)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
614 t t) ; armor & textmode
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
615 (unless (> (point-max) (point-min))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
616 (pop-to-buffer mml2015-result-buffer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
617 (error "Encrypt error"))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
618 (goto-char (point-min))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
619 (while (re-search-forward "\r+$" nil t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
620 (replace-match "" t t))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
621 (set-buffer text)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
622 (delete-region (point-min) (point-max))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
623 (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
624 boundary))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
625 (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
626 (insert (format "--%s\n" boundary))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
627 (insert "Content-Type: application/pgp-encrypted\n\n")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
628 (insert "Version: 1\n\n")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
629 (insert (format "--%s\n" boundary))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
630 (insert "Content-Type: application/octet-stream\n\n")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
631 (insert-buffer-substring cipher)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
632 (goto-char (point-max))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
633 (insert (format "--%s--\n" boundary))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
634 (goto-char (point-max))))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
635
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
636 ;;; pgg wrapper
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
637
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
638 (eval-when-compile
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
639 (defvar pgg-default-user-id)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
640 (defvar pgg-errors-buffer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
641 (defvar pgg-output-buffer))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
642
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
643 (eval-and-compile
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
644 (autoload 'pgg-decrypt-region "pgg")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
645 (autoload 'pgg-verify-region "pgg")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
646 (autoload 'pgg-sign-region "pgg")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
647 (autoload 'pgg-encrypt-region "pgg")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
648 (autoload 'pgg-parse-armor "pgg-parse"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
649
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
650 (defun mml2015-pgg-decrypt (handle ctl)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
651 (catch 'error
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
652 (let ((pgg-errors-buffer mml2015-result-buffer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
653 child handles result decrypt-status)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
654 (unless (setq child (mm-find-part-by-type
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
655 (cdr handle)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
656 "application/octet-stream" nil t))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
657 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
658 mm-security-handle 'gnus-info "Corrupted")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
659 (throw 'error handle))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
660 (with-temp-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
661 (mm-insert-part child)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
662 (if (condition-case err
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
663 (prog1
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
664 (pgg-decrypt-region (point-min) (point-max))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
665 (setq decrypt-status
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
666 (with-current-buffer mml2015-result-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
667 (buffer-string)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
668 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
669 mm-security-handle 'gnus-details
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
670 decrypt-status))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
671 (error
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
672 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
673 mm-security-handle 'gnus-details (mml2015-format-error err))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
674 nil)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
675 (quit
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
676 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
677 mm-security-handle 'gnus-details "Quit.")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
678 nil))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
679 (with-current-buffer pgg-output-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
680 (goto-char (point-min))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
681 (while (search-forward "\r\n" nil t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
682 (replace-match "\n" t t))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
683 (setq handles (mm-dissect-buffer t))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
684 (mm-destroy-parts handle)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
685 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
686 mm-security-handle 'gnus-info "OK")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
687 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
688 mm-security-handle 'gnus-details
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
689 (concat decrypt-status
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
690 (when (stringp (car handles))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
691 "\n" (mm-handle-multipart-ctl-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
692 handles 'gnus-details))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
693 (if (listp (car handles))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
694 handles
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
695 (list handles)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
696 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
697 mm-security-handle 'gnus-info "Failed")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
698 (throw 'error handle))))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
699
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
700 (defun mml2015-pgg-clear-decrypt ()
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
701 (let ((pgg-errors-buffer mml2015-result-buffer))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
702 (if (prog1
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
703 (pgg-decrypt-region (point-min) (point-max))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
704 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
705 mm-security-handle 'gnus-details
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
706 (with-current-buffer mml2015-result-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
707 (buffer-string))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
708 (progn
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
709 (erase-buffer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
710 (insert-buffer-substring pgg-output-buffer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
711 (goto-char (point-min))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
712 (while (search-forward "\r\n" nil t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
713 (replace-match "\n" t t))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
714 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
715 mm-security-handle 'gnus-info "OK"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
716 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
717 mm-security-handle 'gnus-info "Failed"))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
718
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
719 (defun mml2015-pgg-verify (handle ctl)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
720 (let ((pgg-errors-buffer mml2015-result-buffer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
721 signature-file part signature)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
722 (if (or (null (setq part (mm-find-raw-part-by-type
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
723 ctl (or (mm-handle-multipart-ctl-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
724 ctl 'protocol)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
725 "application/pgp-signature")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
726 t)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
727 (null (setq signature (mm-find-part-by-type
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
728 (cdr handle) "application/pgp-signature" nil t))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
729 (progn
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
730 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
731 mm-security-handle 'gnus-info "Corrupted")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
732 handle)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
733 (with-temp-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
734 (insert part)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
735 ;; Convert <LF> to <CR><LF> in verify mode. Sign and
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
736 ;; clearsign use --textmode. The conversion is not necessary.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
737 ;; In clearverify, the conversion is not necessary either.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
738 (goto-char (point-min))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
739 (end-of-line)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
740 (while (not (eobp))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
741 (unless (eq (char-before) ?\r)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
742 (insert "\r"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
743 (forward-line)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
744 (end-of-line))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
745 (with-temp-file (setq signature-file (mm-make-temp-file "pgg"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
746 (mm-insert-part signature))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
747 (if (condition-case err
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
748 (prog1
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
749 (pgg-verify-region (point-min) (point-max)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
750 signature-file t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
751 (goto-char (point-min))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
752 (while (search-forward "\r\n" nil t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
753 (replace-match "\n" t t))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
754 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
755 mm-security-handle 'gnus-details
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
756 (concat (with-current-buffer pgg-output-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
757 (buffer-string))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
758 (with-current-buffer pgg-errors-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
759 (buffer-string)))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
760 (error
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
761 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
762 mm-security-handle 'gnus-details (mml2015-format-error err))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
763 nil)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
764 (quit
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
765 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
766 mm-security-handle 'gnus-details "Quit.")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
767 nil))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
768 (progn
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
769 (delete-file signature-file)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
770 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
771 mm-security-handle 'gnus-info
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
772 (with-current-buffer pgg-errors-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
773 (mml2015-gpg-extract-signature-details))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
774 (delete-file signature-file)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
775 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
776 mm-security-handle 'gnus-info "Failed")))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
777 handle)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
778
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
779 (defun mml2015-pgg-clear-verify ()
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
780 (let ((pgg-errors-buffer mml2015-result-buffer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
781 (text (buffer-string))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
782 (coding-system buffer-file-coding-system))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
783 (if (condition-case err
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
784 (prog1
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
785 (mm-with-unibyte-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
786 (insert (encode-coding-string text coding-system))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
787 (pgg-verify-region (point-min) (point-max) nil t))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
788 (goto-char (point-min))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
789 (while (search-forward "\r\n" nil t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
790 (replace-match "\n" t t))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
791 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
792 mm-security-handle 'gnus-details
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
793 (concat (with-current-buffer pgg-output-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
794 (buffer-string))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
795 (with-current-buffer pgg-errors-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
796 (buffer-string)))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
797 (error
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
798 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
799 mm-security-handle 'gnus-details (mml2015-format-error err))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
800 nil)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
801 (quit
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
802 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
803 mm-security-handle 'gnus-details "Quit.")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
804 nil))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
805 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
806 mm-security-handle 'gnus-info
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
807 (with-current-buffer pgg-errors-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
808 (mml2015-gpg-extract-signature-details)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
809 (mm-set-handle-multipart-parameter
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
810 mm-security-handle 'gnus-info "Failed"))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
811
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
812 (defun mml2015-pgg-sign (cont)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
813 (let ((pgg-errors-buffer mml2015-result-buffer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
814 (boundary (mml-compute-boundary cont))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
815 (pgg-default-user-id (or (message-options-get 'mml-sender)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
816 pgg-default-user-id))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
817 entry)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
818 (unless (pgg-sign-region (point-min) (point-max))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
819 (pop-to-buffer mml2015-result-buffer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
820 (error "Sign error"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
821 (goto-char (point-min))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
822 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
823 boundary))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
824 (if (setq entry (assq 2 (pgg-parse-armor
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
825 (with-current-buffer pgg-output-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
826 (buffer-string)))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
827 (setq entry (assq 'hash-algorithm (cdr entry))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
828 (insert (format "\tmicalg=%s; "
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
829 (if (cdr entry)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
830 (downcase (format "pgp-%s" (cdr entry)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
831 "pgp-sha1")))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
832 (insert "protocol=\"application/pgp-signature\"\n")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
833 (insert (format "\n--%s\n" boundary))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
834 (goto-char (point-max))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
835 (insert (format "\n--%s\n" boundary))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
836 (insert "Content-Type: application/pgp-signature\n\n")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
837 (insert-buffer-substring pgg-output-buffer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
838 (goto-char (point-max))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
839 (insert (format "--%s--\n" boundary))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
840 (goto-char (point-max))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
841
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
842 (defun mml2015-pgg-encrypt (cont &optional sign)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
843 (let ((pgg-errors-buffer mml2015-result-buffer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
844 (boundary (mml-compute-boundary cont)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
845 (unless (pgg-encrypt-region (point-min) (point-max)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
846 (split-string
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
847 (or
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
848 (message-options-get 'message-recipients)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
849 (message-options-set 'message-recipients
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
850 (read-string "Recipients: ")))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
851 "[ \f\t\n\r\v,]+")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
852 sign)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
853 (pop-to-buffer mml2015-result-buffer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
854 (error "Encrypt error"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
855 (delete-region (point-min) (point-max))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
856 (goto-char (point-min))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
857 (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
858 boundary))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
859 (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
860 (insert (format "--%s\n" boundary))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
861 (insert "Content-Type: application/pgp-encrypted\n\n")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
862 (insert "Version: 1\n\n")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
863 (insert (format "--%s\n" boundary))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
864 (insert "Content-Type: application/octet-stream\n\n")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
865 (insert-buffer-substring pgg-output-buffer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
866 (goto-char (point-max))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
867 (insert (format "--%s--\n" boundary))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
868 (goto-char (point-max))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
869
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
870 ;;; General wrapper
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
871
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
872 (defun mml2015-clean-buffer ()
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
873 (if (gnus-buffer-live-p mml2015-result-buffer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
874 (with-current-buffer mml2015-result-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
875 (erase-buffer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
876 t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
877 (setq mml2015-result-buffer
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
878 (gnus-get-buffer-create "*MML2015 Result*"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
879 nil))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
880
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
881 (defsubst mml2015-clear-decrypt-function ()
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
882 (nth 6 (assq mml2015-use mml2015-function-alist)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
883
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
884 (defsubst mml2015-clear-verify-function ()
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
885 (nth 5 (assq mml2015-use mml2015-function-alist)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
886
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
887 ;;;###autoload
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
888 (defun mml2015-decrypt (handle ctl)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
889 (mml2015-clean-buffer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
890 (let ((func (nth 4 (assq mml2015-use mml2015-function-alist))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
891 (if func
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
892 (funcall func handle ctl)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
893 handle)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
894
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
895 ;;;###autoload
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
896 (defun mml2015-decrypt-test (handle ctl)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
897 mml2015-use)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
898
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
899 ;;;###autoload
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
900 (defun mml2015-verify (handle ctl)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
901 (mml2015-clean-buffer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
902 (let ((func (nth 3 (assq mml2015-use mml2015-function-alist))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
903 (if func
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
904 (funcall func handle ctl)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
905 handle)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
906
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
907 ;;;###autoload
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
908 (defun mml2015-verify-test (handle ctl)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
909 mml2015-use)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
910
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
911 ;;;###autoload
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
912 (defun mml2015-encrypt (cont &optional sign)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
913 (mml2015-clean-buffer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
914 (let ((func (nth 2 (assq mml2015-use mml2015-function-alist))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
915 (if func
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
916 (funcall func cont sign)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
917 (error "Cannot find encrypt function"))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
918
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
919 ;;;###autoload
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
920 (defun mml2015-sign (cont)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
921 (mml2015-clean-buffer)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
922 (let ((func (nth 1 (assq mml2015-use mml2015-function-alist))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
923 (if func
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
924 (funcall func cont)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
925 (error "Cannot find sign function"))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
926
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
927 ;;;###autoload
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
928 (defun mml2015-self-encrypt ()
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
929 (mml2015-encrypt nil))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
930
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
931 (provide 'mml2015)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
932
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
933 ;;; arch-tag: b04701d5-0b09-44d8-bed8-de901bf435f2
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
934 ;;; mml2015.el ends here