/[emacs]/emacs/lisp/pgg-gpg.el
ViewVC logotype

Diff of /emacs/lisp/pgg-gpg.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by eliz, Mon Oct 24 09:46:27 2005 UTC revision 1.2 by eliz, Sat Oct 29 11:31:08 2005 UTC
# Line 4  Line 4 
4  ;;   2005 Free Software Foundation, Inc.  ;;   2005 Free Software Foundation, Inc.
5    
6  ;; Author: Daiki Ueno <ueno@unixuser.org>  ;; Author: Daiki Ueno <ueno@unixuser.org>
7    ;; Symmetric encryption added by: Sascha Wilde <wilde@sha-bang.de>
8  ;; Created: 1999/10/28  ;; Created: 1999/10/28
9  ;; Keywords: PGP, OpenPGP, GnuPG  ;; Keywords: PGP, OpenPGP, GnuPG
10    
# Line 96  Line 97 
97            (delete-file output-file-name))            (delete-file output-file-name))
98        (set-default-file-modes orig-mode))))        (set-default-file-modes orig-mode))))
99    
100  (defun pgg-gpg-possibly-cache-passphrase (passphrase &optional key)  (defun pgg-gpg-possibly-cache-passphrase (passphrase &optional key notruncate)
101    (if (and pgg-cache-passphrase    (if (and pgg-cache-passphrase
102             (progn             (progn
103               (goto-char (point-min))               (goto-char (point-min))
104               (re-search-forward "^\\[GNUPG:] \\(GOOD_PASSPHRASE\\>\\)\\|\\(SIG_CREATED\\)" nil t)))               (re-search-forward "^\\[GNUPG:] \\(GOOD_PASSPHRASE\\>\\)\\|\\(SIG_CREATED\\)" nil t)))
105        (pgg-add-passphrase-cache        (pgg-add-passphrase-to-cache
106         (or key         (or key
107             (progn             (progn
108               (goto-char (point-min))               (goto-char (point-min))
109               (if (re-search-forward               (if (re-search-forward
110                    "^\\[GNUPG:] NEED_PASSPHRASE\\(_PIN\\)? \\w+ ?\\w*" nil t)                    "^\\[GNUPG:] NEED_PASSPHRASE\\(_PIN\\)? \\w+ ?\\w*" nil t)
111                   (substring (match-string 0) -8))))                   (substring (match-string 0) -8))))
112         passphrase)))         passphrase
113           notruncate)))
114    
115  (defvar pgg-gpg-all-secret-keys 'unknown)  (defvar pgg-gpg-all-secret-keys 'unknown)
116    
# Line 139  Line 141 
141                               nil t)                               nil t)
142            (substring (match-string 2) 8)))))            (substring (match-string 2) 8)))))
143    
144  (defun pgg-gpg-encrypt-region (start end recipients &optional sign)  (defun pgg-gpg-lookup-key-owner (string &optional all)
145      "Search keys associated with STRING and return owner of identified key.
146    
147    The value may be just the bare key id, or it may be a combination of the
148    user name associated with the key and the key id, with the key id enclosed
149    in \"<...>\" angle brackets.
150    
151    Optional ALL non-nil means search all keys, including secret keys."
152      (let ((args (list "--with-colons" "--no-greeting" "--batch"
153                        (if all "--list-secret-keys" "--list-keys")
154                        string))
155            (key-regexp (concat "^\\(sec\\|pub\\)"
156                                ":[^:]*:[^:]*:[^:]*:\\([^:]*\\):[^:]*"
157                                ":[^:]*:[^:]*:[^:]*:\\([^:]*\\):"))
158            )
159        (with-temp-buffer
160          (apply #'call-process pgg-gpg-program nil t nil args)
161          (goto-char (point-min))
162          (if (re-search-forward key-regexp
163                                 nil t)
164              (match-string 3)))))
165    
166    (defun pgg-gpg-key-id-from-key-owner (key-owner)
167      (cond ((not key-owner) nil)
168            ;; Extract bare key id from outermost paired angle brackets, if any:
169            ((string-match "[^<]*<\\(.+\\)>[^>]*" key-owner)
170             (substring key-owner (match-beginning 1)(match-end 1)))
171            (key-owner))
172      )
173    
174    (defun pgg-gpg-encrypt-region (start end recipients &optional sign passphrase)
175    "Encrypt the current region between START and END.    "Encrypt the current region between START and END.
176  If optional argument SIGN is non-nil, do a combined sign and encrypt."  
177    If optional argument SIGN is non-nil, do a combined sign and encrypt.
178    
179    If optional PASSPHRASE is not specified, it will be obtained from the
180    passphrase cache or user."
181    (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))    (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
182           (passphrase           (passphrase (or passphrase
183            (when sign                           (when sign
184              (pgg-read-passphrase                             (pgg-read-passphrase
185               (format "GnuPG passphrase for %s: " pgg-gpg-user-id)                              (format "GnuPG passphrase for %s: "
186               pgg-gpg-user-id)))                                      pgg-gpg-user-id)
187                                pgg-gpg-user-id))))
188           (args           (args
189            (append            (append
190             (list "--batch" "--armor" "--always-trust" "--encrypt")             (list "--batch" "--textmode" "--armor" "--always-trust" "--encrypt")
191             (if sign (list "--sign" "--local-user" pgg-gpg-user-id))             (if sign (list "--sign" "--local-user" pgg-gpg-user-id))
192             (if recipients             (if recipients
193                 (apply #'nconc                 (apply #'nconc
# Line 169  If optional argument SIGN is non-nil, do Line 206  If optional argument SIGN is non-nil, do
206          (pgg-gpg-possibly-cache-passphrase passphrase)))          (pgg-gpg-possibly-cache-passphrase passphrase)))
207      (pgg-process-when-success)))      (pgg-process-when-success)))
208    
209  (defun pgg-gpg-decrypt-region (start end)  (defun pgg-gpg-encrypt-symmetric-region (start end &optional passphrase)
210    "Decrypt the current region between START and END."    "Encrypt the current region between START and END with symmetric cipher.
211    
212    If optional PASSPHRASE is not specified, it will be obtained from the
213    passphrase cache or user."
214      (let* ((passphrase (or passphrase
215                             (pgg-read-passphrase
216                              "GnuPG passphrase for symmetric encryption: ")))
217             (args
218              (append (list "--batch" "--textmode" "--armor" "--symmetric" ))))
219        (pgg-as-lbt start end 'CRLF
220          (pgg-gpg-process-region start end passphrase pgg-gpg-program args))
221        (pgg-process-when-success)))
222    
223    (defun pgg-gpg-decrypt-region (start end &optional passphrase)
224      "Decrypt the current region between START and END.
225    
226    If optional PASSPHRASE is not specified, it will be obtained from the
227    passphrase cache or user."
228    (let* ((current-buffer (current-buffer))    (let* ((current-buffer (current-buffer))
229           (message-keys (with-temp-buffer           (message-keys (with-temp-buffer
230                           (insert-buffer-substring current-buffer)                           (insert-buffer-substring current-buffer)
231                           (pgg-decode-armor-region (point-min) (point-max))))                           (pgg-decode-armor-region (point-min) (point-max))))
232           (secret-keys (pgg-gpg-lookup-all-secret-keys))           (secret-keys (pgg-gpg-lookup-all-secret-keys))
233             ;; XXX the user is stuck if they need to use the passphrase for
234             ;;     any but the first secret key for which the message is
235             ;;     encrypted.  ideally, we would incrementally give them a
236             ;;     chance with subsequent keys each time they fail with one.
237           (key (pgg-gpg-select-matching-key message-keys secret-keys))           (key (pgg-gpg-select-matching-key message-keys secret-keys))
238           (pgg-gpg-user-id (or key pgg-gpg-user-id pgg-default-user-id))           (key-owner (and key (pgg-gpg-lookup-key-owner key t)))
239           (passphrase           (key-id (pgg-gpg-key-id-from-key-owner key-owner))
240            (pgg-read-passphrase           (pgg-gpg-user-id (or key-id key
241             (format "GnuPG passphrase for %s: " pgg-gpg-user-id)                                pgg-gpg-user-id pgg-default-user-id))
242             pgg-gpg-user-id))           (passphrase (or passphrase
243                             (pgg-read-passphrase
244                              (format (if (pgg-gpg-symmetric-key-p message-keys)
245                                          "Passphrase for symmetric decryption: "
246                                        "GnuPG passphrase for %s: ")
247                                      (or key-owner "??"))
248                              pgg-gpg-user-id)))
249           (args '("--batch" "--decrypt")))           (args '("--batch" "--decrypt")))
250      (pgg-gpg-process-region start end passphrase pgg-gpg-program args)      (pgg-gpg-process-region start end passphrase pgg-gpg-program args)
251      (with-current-buffer pgg-errors-buffer      (with-current-buffer pgg-errors-buffer
# Line 189  If optional argument SIGN is non-nil, do Line 253  If optional argument SIGN is non-nil, do
253        (goto-char (point-min))        (goto-char (point-min))
254        (re-search-forward "^\\[GNUPG:] DECRYPTION_OKAY\\>" nil t))))        (re-search-forward "^\\[GNUPG:] DECRYPTION_OKAY\\>" nil t))))
255    
256    ;;;###autoload
257    (defun pgg-gpg-symmetric-key-p (message-keys)
258      "True if decoded armor MESSAGE-KEYS has symmetric encryption indicator."
259      (let (result)
260        (dolist (key message-keys result)
261          (when (and (eq (car key) 3)
262                     (member '(symmetric-key-algorithm) key))
263            (setq result key)))))
264    
265  (defun pgg-gpg-select-matching-key (message-keys secret-keys)  (defun pgg-gpg-select-matching-key (message-keys secret-keys)
266    "Choose a key from MESSAGE-KEYS that matches one of the keys in SECRET-KEYS."    "Choose a key from MESSAGE-KEYS that matches one of the keys in SECRET-KEYS."
267    (loop for message-key in message-keys    (loop for message-key in message-keys
268          for message-key-id = (and (equal (car message-key) 1)          for message-key-id = (and (equal (car message-key) 1)
269                                    (cdr (assq 'key-identifier message-key)))                                    (cdr (assq 'key-identifier
270                                                 (cdr message-key))))
271          for key = (and message-key-id (pgg-lookup-key message-key-id 'encrypt))          for key = (and message-key-id (pgg-lookup-key message-key-id 'encrypt))
272          when (and key (member key secret-keys)) return key))          when (and key (member key secret-keys)) return key))
273    
274  (defun pgg-gpg-sign-region (start end &optional cleartext)  (defun pgg-gpg-sign-region (start end &optional cleartext passphrase)
275    "Make detached signature from text between START and END."    "Make detached signature from text between START and END."
276    (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))    (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
277           (passphrase           (passphrase (or passphrase
278            (pgg-read-passphrase                           (pgg-read-passphrase
279             (format "GnuPG passphrase for %s: " pgg-gpg-user-id)                            (format "GnuPG passphrase for %s: " pgg-gpg-user-id)
280             pgg-gpg-user-id))                            pgg-gpg-user-id)))
281           (args           (args
282            (list (if cleartext "--clearsign" "--detach-sign")            (list (if cleartext "--clearsign" "--detach-sign")
283                  "--armor" "--batch" "--verbose"                  "--armor" "--batch" "--verbose"

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26