* epg.el (epg-make-signature): Removed user-id.
[elisp/epg.git] / pgg-epg.el
1 ;;; pgg-epg.el --- Gnus/PGG backend of EasyPG.
2 ;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
3 ;;   2005, 2006 Free Software Foundation, Inc.
4 ;; Copyright (C) 2006 Daiki Ueno
5
6 ;; Author: Daiki Ueno <ueno@unixuser.org>
7 ;; Keywords: PGP, GnuPG
8
9 ;; This file is part of EasyPG.
10
11 ;; This program is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version.
15
16 ;; This program is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19 ;; GNU General Public License for more details.
20
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 ;; Boston, MA 02110-1301, USA.
25
26 ;;; Commentary:
27
28 ;; To use, add (setq pgg-scheme 'epg) to your ~/.gnus.
29
30 ;;; Code:
31
32 (require 'epg)
33 (eval-when-compile (require 'pgg))
34
35 (defvar pgg-epg-secret-key-id-list nil)
36
37 (defun pgg-epg-passphrase-callback (context key-id ignore)
38   (if (eq key-id 'SYM)
39       (epg-passphrase-callback-function context key-id nil)
40     (let* ((entry (assoc key-id epg-user-id-alist))
41            (passphrase
42             (pgg-read-passphrase
43              (format "GnuPG passphrase for %s: "
44                      (if entry
45                          (cdr entry)
46                        key-id))
47              (if (eq key-id 'PIN)
48                  "PIN"
49                key-id))))
50       (when passphrase
51         (pgg-add-passphrase-to-cache key-id passphrase)
52         (setq pgg-epg-secret-key-id-list
53               (cons key-id pgg-epg-secret-key-id-list))
54         (copy-sequence passphrase)))))
55
56 (defvar inhibit-redisplay)
57 (defun pgg-epg-encrypt-region (start end recipients &optional sign passphrase)
58   "This function is for internal use only.
59
60 Encrypt the current region between START and END.
61
62 If optional argument SIGN is non-nil, do a combined sign and encrypt.
63
64 If optional PASSPHRASE is not specified, it will be obtained from the
65 passphrase cache or user."
66   (let ((context (epg-make-context))
67         (inhibit-redisplay t)           ;Gnus users don't like flickering
68         cipher)
69     (epg-context-set-armor context t)
70     (epg-context-set-textmode context pgg-text-mode)
71     (epg-context-set-passphrase-callback context #'pgg-epg-passphrase-callback)
72     (get-buffer-create pgg-output-buffer)
73     (get-buffer-create pgg-errors-buffer)
74     (condition-case error
75         (setq cipher
76               (epg-encrypt-string context
77                                   (buffer-substring start end)
78                                   (mapcar
79                                    (lambda (recipient)
80                                      (car (epg-list-keys recipient)))
81                                    (if pgg-encrypt-for-me
82                                        (cons pgg-default-user-id recipients)
83                                      recipients))
84                                   sign t)
85               pgg-epg-secret-key-id-list nil)
86       (error
87        (while pgg-epg-secret-key-id-list
88          (pgg-remove-passphrase-from-cache (car pgg-epg-secret-key-id-list))
89          (setq pgg-epg-secret-key-id-list (cdr pgg-epg-secret-key-id-list)))
90        (signal (car error) (cdr error))))
91     (save-excursion
92       (set-buffer (get-buffer-create pgg-output-buffer))
93       (erase-buffer)
94       (insert cipher))
95     t))
96
97 (defun pgg-epg-encrypt-symmetric-region (start end &optional passphrase)
98   "This function is for internal use only.
99
100 Encrypt the current region between START and END with symmetric cipher.
101
102 If optional PASSPHRASE is not specified, it will be obtained from the
103 passphrase cache or user."
104   (pgg-epg-encrypt-region start end nil))
105
106 (defun pgg-epg-decrypt-region (start end &optional passphrase)
107   "This function is for internal use only.
108
109 Decrypt the current region between START and END.
110
111 If optional PASSPHRASE is not specified, it will be obtained from the
112 passphrase cache or user."
113   (let ((context (epg-make-context))
114         (inhibit-redisplay t)           ;Gnus users don't like flickering
115         plain)
116     (epg-context-set-armor context t)
117     (epg-context-set-textmode context pgg-text-mode)
118     (epg-context-set-passphrase-callback context #'pgg-epg-passphrase-callback)
119     (get-buffer-create pgg-output-buffer)
120     (get-buffer-create pgg-errors-buffer)
121     (condition-case error
122         (setq plain (epg-decrypt-string context (buffer-substring start end))
123               pgg-epg-secret-key-id-list nil)
124       (error
125        (while pgg-epg-secret-key-id-list
126          (pgg-remove-passphrase-from-cache (car pgg-epg-secret-key-id-list))
127          (setq pgg-epg-secret-key-id-list (cdr pgg-epg-secret-key-id-list)))
128        (signal (car error) (cdr error))))
129     (save-excursion
130       (set-buffer (get-buffer-create pgg-output-buffer))
131       (erase-buffer)
132       (insert plain))
133     t))
134
135 (defun pgg-epg-sign-region (start end &optional cleartext passphrase)
136   "This function is for internal use only.
137
138 Make detached signature from text between START and END.
139
140 If optional PASSPHRASE is not specified, it will be obtained from the
141 passphrase cache or user."
142   (let ((context (epg-make-context))
143         (inhibit-redisplay t)           ;Gnus users don't like flickering
144         signature)
145     (epg-context-set-armor context t)
146     (epg-context-set-textmode context pgg-text-mode)
147     (epg-context-set-passphrase-callback context #'pgg-epg-passphrase-callback)
148     (get-buffer-create pgg-output-buffer)
149     (get-buffer-create pgg-errors-buffer)
150     (condition-case error
151         (setq signature
152               (epg-sign-string context
153                                (buffer-substring start end)
154                                (if cleartext
155                                    'clearsign
156                                  'detached))
157               pgg-epg-secret-key-id-list nil)
158       (error
159        (while pgg-epg-secret-key-id-list
160          (pgg-remove-passphrase-from-cache (car pgg-epg-secret-key-id-list))
161          (setq pgg-epg-secret-key-id-list (cdr pgg-epg-secret-key-id-list)))
162        (signal (car error) (cdr error))))
163     (save-excursion
164       (set-buffer (get-buffer-create pgg-output-buffer))
165       (erase-buffer)
166       (insert signature))
167     t))
168
169 (defvar pgg-epg-signatures nil)
170
171 (defun pgg-epg-verify-region (start end &optional signature)
172   "This function is for internal use only.
173
174 Verify region between START and END as the detached signature SIGNATURE."
175   (let ((context (epg-make-context))
176         (inhibit-redisplay t))          ;Gnus users don't like flickering
177     (epg-context-set-armor context t)
178     (epg-context-set-textmode context pgg-text-mode)
179     (get-buffer-create pgg-output-buffer)
180     (get-buffer-create pgg-errors-buffer)
181     (if signature
182         (epg-verify-string context
183                            (with-temp-buffer
184                              (insert-file-contents signature)
185                              (buffer-string))
186                            (buffer-substring start end))
187       (epg-verify-string context (buffer-substring start end)))
188     (save-excursion
189       (set-buffer (get-buffer-create pgg-errors-buffer))
190       (make-local-variable 'pgg-epg-signatures)
191       (setq pgg-epg-signatures (epg-context-result-for context 'verify))
192       (erase-buffer)
193       (insert (epg-verify-result-to-string pgg-epg-signatures)))
194     t))
195
196 (defun pgg-epg-insert-key ()
197   "This function is for internal use only.
198
199 Insert public key at point."
200   (let ((context (epg-make-context))
201         (inhibit-redisplay t)           ;Gnus users don't like flickering
202         )
203     (epg-context-set-armor context t)
204     (epg-context-set-textmode context pgg-text-mode)
205     (get-buffer-create pgg-output-buffer)
206     (get-buffer-create pgg-errors-buffer)
207     (insert (epg-export-keys-to-string context pgg-default-user-id))))
208
209 (defun pgg-epg-snarf-keys-region (start end)
210   "This function is for internal use only.
211
212 Add all public keys in region between START and END to the keyring."
213   (let ((context (epg-make-context))
214         (inhibit-redisplay t)           ;Gnus users don't like flickering
215         )
216     (epg-context-set-armor context t)
217     (epg-context-set-textmode context pgg-text-mode)
218     (get-buffer-create pgg-output-buffer)
219     (get-buffer-create pgg-errors-buffer)
220     (epg-import-keys-from-string context (buffer-substring start end))))
221
222 (eval-when-compile
223   (autoload 'mml2015-gpg-pretty-print-fpr "mml2015"))
224 (defun mml2015-gpg-extract-signature-details ()
225   (if pgg-epg-signatures
226       (let* ((expired (eq (epg-signature-status (car pgg-epg-signatures))
227                           'key-expired))
228              (signer (cons (epg-signature-key-id (car pgg-epg-signatures))
229                            (cdr (assoc (epg-signature-key-id
230                                         (car pgg-epg-signatures))
231                                        epg-user-id-alist))))
232              (fprint (epg-signature-fingerprint (car pgg-epg-signatures)))
233              (trust-good-enough-p
234               (memq (epg-signature-validity (car pgg-epg-signatures))
235                     '(marginal fully ultimate))))
236         (cond ((and signer fprint)
237                (concat (cdr signer)
238                        (unless trust-good-enough-p
239                          (concat "\nUntrusted, Fingerprint: "
240                                  (mml2015-gpg-pretty-print-fpr fprint)))
241                        (when expired
242                          (format "\nWARNING: Signature from expired key (%s)"
243                                  (car signer)))))
244               (t
245                "From unknown user")))
246     "From unknown user"))
247
248 (provide 'pgg-epg)
249
250 ;;; pgg-epg.el ends here