From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Ken Manheimer Newsgroups: gmane.emacs.devel Subject: Re: pgg symmetric encryption patch Date: Tue, 25 Oct 2005 17:28:37 -0400 Message-ID: <2cd46e7f0510251428l7b143956m5d7635e4b38898b0@mail.gmail.com> References: <20051007100014.GB4850@kenny.sha-bang.local> <2cd46e7f0510081131h14e2bbeaga7f1a33ebd6347c8@mail.gmail.com> <2cd46e7f0510101415t76825ea7u9749fe23da54ce@mail.gmail.com> <2cd46e7f0510121647x3c51fb65pc883ed61f4e864ab@mail.gmail.com> <2cd46e7f0510200708x4640d1c2t50743cf439e52dd4@mail.gmail.com> <20051020144236.GA6418@kenny.sha-bang.local> <2cd46e7f0510251326w61ad1899wcf8286d04387e962@mail.gmail.com> NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="----=_Part_58195_6127455.1130275717869" X-Trace: sea.gmane.org 1130275982 1224 80.91.229.2 (25 Oct 2005 21:33:02 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Tue, 25 Oct 2005 21:33:02 +0000 (UTC) Cc: Simon Josefsson , sascha schwab , "Daiki Ueno \(pgg author\)" , "Richard M. Stallman" , emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue Oct 25 23:32:47 2005 Return-path: Original-Received: from lists.gnu.org ([199.232.76.165]) by ciao.gmane.org with esmtp (Exim 4.43) id 1EUWLq-0007zk-Gc for ged-emacs-devel@m.gmane.org; Tue, 25 Oct 2005 23:29:03 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1EUWLo-0007Nz-Me for ged-emacs-devel@m.gmane.org; Tue, 25 Oct 2005 17:28:56 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1EUWLZ-0007Mt-H7 for emacs-devel@gnu.org; Tue, 25 Oct 2005 17:28:41 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1EUWLX-0007He-0N for emacs-devel@gnu.org; Tue, 25 Oct 2005 17:28:41 -0400 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1EUWLW-0007HT-Rp for emacs-devel@gnu.org; Tue, 25 Oct 2005 17:28:38 -0400 Original-Received: from [64.233.162.198] (helo=zproxy.gmail.com) by monty-python.gnu.org with esmtp (Exim 4.34) id 1EUWLW-0004tG-JU for emacs-devel@gnu.org; Tue, 25 Oct 2005 17:28:39 -0400 Original-Received: by zproxy.gmail.com with SMTP id k1so8974nzf for ; Tue, 25 Oct 2005 14:28:38 -0700 (PDT) DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=beta; d=gmail.com; h=received:message-id:date:from:to:subject:cc:in-reply-to:mime-version:content-type:references; b=e+l+I4ajbeaWJO8hDxVw0Mlslucd+iyNgYX11eeJzkiyqPAtua8euvV3aQOpb2IouDTOpzTW+L8u4qkawVu0cICM+CBztNkv+9AEgaTf2FX/wIoW+ncozwtHh5IXwF23h6PEFJ3sk678DKBkpJA94w1NcN38g2h0u6HzaLOgIA4= Original-Received: by 10.36.129.4 with SMTP id b4mr197961nzd; Tue, 25 Oct 2005 14:28:37 -0700 (PDT) Original-Received: by 10.36.39.19 with HTTP; Tue, 25 Oct 2005 14:28:37 -0700 (PDT) Original-To: Sascha Wilde In-Reply-To: X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:44868 Archived-At: ------=_Part_58195_6127455.1130275717869 Content-Type: text/plain; charset=ISO-8859-1 Content-Transfer-Encoding: quoted-printable Content-Disposition: inline aargh - i'm attaching it now. (i simply forgot to do so, in my previous po= st.) On 10/25/05, Sascha Wilde wrote: > Ken Manheimer wrote: > > > On 10/25/05, Sascha Wilde wrote: > > > i'm attaching a cumulative patch, > > no, you didn't... > > guess we have some kind of tradition here. ;-) > > cheers > sascha > -- > "Anyone who slaps a 'this page is best viewed with Browser X' label on a = Web > page appears to be yearning for the bad old days, before the Web, when yo= u had > very little chance of reading a document written on another computer, ano= ther > word processor, or another network." -- Tim Berners-Lee, July 1996 > ------=_Part_58195_6127455.1130275717869 Content-Type: application/octet-stream; name=pgg-symmetric-06.patch Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="pgg-symmetric-06.patch" Index: ChangeLog =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/ChangeLog,v retrieving revision 1.8455 diff -u -r1.8455 ChangeLog --- ChangeLog 25 Oct 2005 19:25:23 -0000 1.8455 +++ ChangeLog 25 Oct 2005 20:16:01 -0000 @@ -1,4 +1,79 @@ -2005-10-25 Romain Francoise +2005-10-12 Ken Manheimer + + * pgg-gpg.el + (pgg-gpg-select-matching-key): fixed: look at the right part of the + decoded armor to find the key-identifier + (pgg-gpg-lookup-key-owner): new function to return the + human-readable identifier of a key owner. + (pgg-gpg-lookup-id-from-key-owner): make it easy to identify the + key itself. + (pgg-gpg-decrypt-region): prompt with the key owner (rather + than the key value) if we have a key and can match it against a + secret key. also, added an XXX note pointing out fact that the + prompt only indicates the first matching key. + (pgg-add-passphrase-to-cache): <= pgg-add-passphrase-cache + (pgg-remove-passphrase-from-cache) <= pgg-remove-passphrase-cache + + * pgg.el (pgg-decrypt): passing along 'passphrase' in call to + pgg-decrypt-region; i overlooked this one in my previous patch. + (pgg-pending-timers): a new hash for tracking the passphrase cache + timers, so that new ones supercede old ones. + (pgg-add-passphrase-to-cache): renamed from + `pgg-add-passphrase-cache' to reduce confusion. and modified to + cancel old timers when new ones are added. + (pgg-remove-passphrase-from-cache): renamed from + `pgg-remove-passphrase-cache' to reduce confusion. and modified + to cancel old timers when their keys are removed from the cache. + (pgg-cancel-timer): in mainline gnu emacs, an alias for + cancel-timer; in xemacs, an indirection to delete-itimer. + (pgg-read-passphrase-from-cache, pgg-read-passphrase): extracted + pgg-read-passphrase-from-cache from pgg-read-passphrase so users + can only check cache without risk of prompting. corrected bug in + notruncate behavior. + (pgg-read-passphrase-from-cache, pgg-read-passphrase, + pgg-add-passphrase-cache, pgg-remove-passphrase-cache): added + informative docstrings. + (pgg-decrypt): convey provided passphrase in subordinate call to + pgg-decrypt-region (missed that in a prior patch) + +2005-10-08 Ken Manheimer + + * pgg.el (pgg-encrypt-region, pgg-encrypt-symmetric-region, + pgg-encrypt-symmetric, pgg-encrypt, pgg-decrypt-region, + pgg-decrypt, pgg-sign-region, pgg-sign): + add optional 'passphrase' argument to all these routines, so the + passphrase can be managed externally and then passed in to the + system. + + * pgg.el (pgg-read-passphrase, pgg-add-passphrase-cache, + pgg-remove-passphrase-cache): add optional 'notruncate' argument, + so the passphrase cache can be used reliably with identifiers + besides a pgp packet's key id. + + * pgg-gpg.el (pgg-pgp-encrypt-region, + pgg-pgp-encrypt-symmetric-region, pgg-pgp-encrypt-symmetric, + pgg-pgp-encrypt, pgg-pgp-decrypt-region, pgg-pgp-decrypt, + pgg-pgp-sign-region, pgg-pgp-sign): add optional 'passphrase' + argument to all these routines, so the passphrase can be managed + externally and passed in to the system. + + * pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): add optional + 'notruncate' argument, so the passphrase cache can be used + reliably with identifiers besides a pgp packet's key id. + +2005-10-06 Sascha Wilde + + * pgg-gpg.el (pgg-gpg-encrypt-symmetric-region): New function for + symmetric encryption. + (pgg-gpg-symmetric-key-p): New function to check for an symmetric + encrypted session key. + (pgg-gpg-decrypt-region): When decrypting a symmetric encrypted + message ask for the passphrase in a proper way. + + * pgg.el (pgg-encrypt-symmetric,pgg-encrypt-symmetric-region): + New user commands for symmetric encryption. + +005-10-25 Romain Francoise * emacs-lisp/find-func.el (find-library-name): Also strip extension if library name ends in .el, to take advantage of Index: pgg.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/pgg.el,v retrieving revision 1.1 diff -u -r1.1 pgg.el --- pgg.el 24 Oct 2005 09:46:27 -0000 1.1 +++ pgg.el 25 Oct 2005 20:16:01 -0000 @@ -4,6 +4,7 @@ ;; 2005 Free Software Foundation, Inc. ;; Author: Daiki Ueno +;; Symmetric encryption added by: Sascha Wilde ;; Created: 1999/10/28 ;; Keywords: PGP @@ -67,26 +68,110 @@ (set-window-buffer window buffer) (shrink-window-if-larger-than-buffer window))) +;; XXX `pgg-display-output-buffer' is a horrible name for this function. +;; It should be something like `pgg-situate-output-or-display-error'. (defun pgg-display-output-buffer (start end status) + "Situate en/decryption results or pop up an error buffer. + +Text from START to END is replaced by contents of output buffer if STATUS +is true, or else the output buffer is displayed." (if status - (progn - (delete-region start end) - (insert-buffer-substring pgg-output-buffer) - (decode-coding-region start (point) buffer-file-coding-system)) - (let ((temp-buffer-show-function - (function pgg-temp-buffer-show-function))) - (with-output-to-temp-buffer pgg-echo-buffer - (set-buffer standard-output) - (insert-buffer-substring pgg-errors-buffer))))) + (pgg-situate-output start end) + (pgg-display-error-buffer))) + +(defun pgg-situate-output (start end) + "Place en/decryption result in place of current text from START to END." + (delete-region start end) + (insert-buffer-substring pgg-output-buffer) + (decode-coding-region start (point) buffer-file-coding-system)) + +(defun pgg-display-error-buffer () + "Pop up an error buffer indicating the reason for an en/decryption failure." + (let ((temp-buffer-show-function + (function pgg-temp-buffer-show-function))) + (with-output-to-temp-buffer pgg-echo-buffer + (set-buffer standard-output) + (insert-buffer-substring pgg-errors-buffer)))) (defvar pgg-passphrase-cache (make-vector 7 0)) -(defun pgg-read-passphrase (prompt &optional key) - (or (and pgg-cache-passphrase - key (setq key (pgg-truncate-key-identifier key)) - (symbol-value (intern-soft key pgg-passphrase-cache))) +(defvar pgg-pending-timers (make-vector 7 0) + "Hash table for managing scheduled pgg cache management timers. + +We associate key and timer, so the timer can be cancelled if a new +timeout for the key is set while an old one is still pending.") + +(defun pgg-read-passphrase (prompt &optional key notruncate) + "Using PROMPT, obtain passphrase for KEY from cache or user. + +Truncate the key to 8 trailing characters unless NOTRUNCATE is true +\(default false). + +Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry' +regulate cache behavior." + (or (pgg-read-passphrase-from-cache key notruncate) (read-passwd prompt))) +(defun pgg-read-passphrase-from-cache (key &optional notruncate) + "Obtain passphrase for KEY from time-limited passphrase cache. + +Truncate the key to 8 trailing characters unless NOTRUNCATE is true +\(default false). + +Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry' +regulate cache behavior." + (and pgg-cache-passphrase + key (or notruncate + (setq key (pgg-truncate-key-identifier key))) + (symbol-value (intern-soft key pgg-passphrase-cache)))) + +(defun pgg-add-passphrase-to-cache (key passphrase &optional notruncate) + "Associate KEY with PASSPHRASE in time-limited passphrase cache. + +Truncate the key to 8 trailing characters unless NOTRUNCATE is true +\(default false). + +Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry' +regulate cache behavior." + + (let* ((key (if notruncate key (pgg-truncate-key-identifier key))) + (interned-timer-key (intern-soft key pgg-pending-timers)) + (old-timer (symbol-value interned-timer-key)) + new-timer) + (when old-timer + (cancel-timer old-timer) + (unintern interned-timer-key pgg-pending-timers)) + (set (intern key pgg-passphrase-cache) + passphrase) + (set (intern key pgg-pending-timers) + (pgg-run-at-time pgg-passphrase-cache-expiry nil + #'pgg-remove-passphrase-from-cache + key notruncate)))) + +(defun pgg-remove-passphrase-from-cache (key &optional notruncate) + "Omit passphrase associated with KEY in time-limited passphrase cache. + +Truncate the key to 8 trailing characters unless NOTRUNCATE is true +\(default false). + +This is a no-op if there is not entry for KEY (eg, it's already expired. + +The memory for the passphrase is filled with underscores to clear any +references to it. + +Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry' +regulate cache behavior." + (let* ((passphrase (pgg-read-passphrase-from-cache key notruncate)) + (key (if notruncate key (pgg-truncate-key-identifier key))) + (interned-timer-key (intern-soft key pgg-pending-timers)) + (old-timer (symbol-value interned-timer-key))) + (when passphrase + (fillarray passphrase ?_) + (unintern key pgg-passphrase-cache)) + (when old-timer + (pgg-cancel-timer old-timer) + (unintern interned-timer-key pgg-pending-timers)))) + (eval-when-compile (defmacro pgg-run-at-time-1 (time repeat function args) (when (featurep 'xemacs) @@ -151,27 +236,20 @@ (eval-and-compile (if (featurep 'xemacs) - (defun pgg-run-at-time (time repeat function &rest args) - "Emulating function run as `run-at-time'. + (progn + (defun pgg-run-at-time (time repeat function &rest args) + "Emulating function run as `run-at-time'. TIME should be nil meaning now, or a number of seconds from now. Return an itimer object which can be used in either `delete-itimer' or `cancel-timer'." - (pgg-run-at-time-1 time repeat function args)) - (defalias 'pgg-run-at-time 'run-at-time))) - -(defun pgg-add-passphrase-cache (key passphrase) - (setq key (pgg-truncate-key-identifier key)) - (set (intern key pgg-passphrase-cache) - passphrase) - (pgg-run-at-time pgg-passphrase-cache-expiry nil - #'pgg-remove-passphrase-cache - key)) - -(defun pgg-remove-passphrase-cache (key) - (let ((passphrase (symbol-value (intern-soft key pgg-passphrase-cache)))) - (when passphrase - (fillarray passphrase ?_) - (unintern key pgg-passphrase-cache)))) + (pgg-run-at-time-1 time repeat function args)) + (defun pgg-cancel-timer (timer) + "Emulate cancel-timer for xemacs." + (let ((delete-itimer 'delete-itimer)) + (funcall delete-itimer timer))) + ) + (defalias 'pgg-run-at-time 'run-at-time) + (defalias 'pgg-cancel-timer 'cancel-timer))) (defmacro pgg-convert-lbt-region (start end lbt) `(let ((pgg-conversion-end (set-marker (make-marker) ,end))) @@ -222,93 +300,156 @@ ;;; ;;;###autoload -(defun pgg-encrypt-region (start end rcpts &optional sign) +(defun pgg-encrypt-region (start end rcpts &optional sign passphrase) "Encrypt the current region between START and END for RCPTS. -If optional argument SIGN is non-nil, do a combined sign and encrypt." + +If optional argument SIGN is non-nil, do a combined sign and encrypt. + +If optional PASSPHRASE is not specified, it will be obtained from the +passphrase cache or user." (interactive (list (region-beginning)(region-end) (split-string (read-string "Recipients: ") "[ \t,]+"))) (let ((status (pgg-save-coding-system start end (pgg-invoke "encrypt-region" (or pgg-scheme pgg-default-scheme) - (point-min) (point-max) rcpts sign)))) + (point-min) (point-max) rcpts sign passphrase)))) (when (interactive-p) (pgg-display-output-buffer start end status)) status)) ;;;###autoload -(defun pgg-encrypt (rcpts &optional sign start end) +(defun pgg-encrypt-symmetric-region (start end &optional passphrase) + "Encrypt the current region between START and END symmetric with passphrase. + +If optional PASSPHRASE is not specified, it will be obtained from the +cache or user." + (interactive "r") + (let ((status + (pgg-save-coding-system start end + (pgg-invoke "encrypt-symmetric-region" + (or pgg-scheme pgg-default-scheme) + (point-min) (point-max) passphrase)))) + (when (interactive-p) + (pgg-display-output-buffer start end status)) + status)) + +;;;###autoload +(defun pgg-encrypt-symmetric (&optional start end passphrase) + "Encrypt the current buffer using a symmetric, rather than key-pair, cipher. + +If optional arguments START and END are specified, only encrypt within +the region. + +If optional PASSPHRASE is not specified, it will be obtained from the +passphrase cache or user." + (interactive) + (let* ((start (or start (point-min))) + (end (or end (point-max))) + (status (pgg-encrypt-symmetric-region start end passphrase))) + (when (interactive-p) + (pgg-display-output-buffer start end status)) + status)) + +;;;###autoload +(defun pgg-encrypt (rcpts &optional sign start end passphrase) "Encrypt the current buffer for RCPTS. + If optional argument SIGN is non-nil, do a combined sign and encrypt. + If optional arguments START and END are specified, only encrypt within -the region." +the region. + +If optional PASSPHRASE is not specified, it will be obtained from the +passphrase cache or user." (interactive (list (split-string (read-string "Recipients: ") "[ \t,]+"))) (let* ((start (or start (point-min))) (end (or end (point-max))) - (status (pgg-encrypt-region start end rcpts sign))) + (status (pgg-encrypt-region start end rcpts sign passphrase))) (when (interactive-p) (pgg-display-output-buffer start end status)) status)) ;;;###autoload -(defun pgg-decrypt-region (start end) - "Decrypt the current region between START and END." +(defun pgg-decrypt-region (start end &optional passphrase) + "Decrypt the current region between START and END. + +If optional PASSPHRASE is not specified, it will be obtained from the +passphrase cache or user." (interactive "r") (let* ((buf (current-buffer)) (status (pgg-save-coding-system start end (pgg-invoke "decrypt-region" (or pgg-scheme pgg-default-scheme) - (point-min) (point-max))))) + (point-min) (point-max) passphrase)))) (when (interactive-p) (pgg-display-output-buffer start end status)) status)) ;;;###autoload -(defun pgg-decrypt (&optional start end) +(defun pgg-decrypt (&optional start end passphrase) "Decrypt the current buffer. + If optional arguments START and END are specified, only decrypt within -the region." +the region. + +If optional PASSPHRASE is not specified, it will be obtained from the +passphrase cache or user." (interactive "") (let* ((start (or start (point-min))) (end (or end (point-max))) - (status (pgg-decrypt-region start end))) + (status (pgg-decrypt-region start end passphrase))) (when (interactive-p) (pgg-display-output-buffer start end status)) status)) ;;;###autoload -(defun pgg-sign-region (start end &optional cleartext) +(defun pgg-sign-region (start end &optional cleartext passphrase) "Make the signature from text between START and END. + If the optional 3rd argument CLEARTEXT is non-nil, it does not create a detached signature. + If this function is called interactively, CLEARTEXT is enabled -and the the output is displayed." +and the the output is displayed. + +If optional PASSPHRASE is not specified, it will be obtained from the +passphrase cache or user." (interactive "r") (let ((status (pgg-save-coding-system start end (pgg-invoke "sign-region" (or pgg-scheme pgg-default-scheme) (point-min) (point-max) - (or (interactive-p) cleartext))))) + (or (interactive-p) cleartext) + passphrase)))) (when (interactive-p) (pgg-display-output-buffer start end status)) status)) ;;;###autoload -(defun pgg-sign (&optional cleartext start end) +(defun pgg-sign (&optional cleartext start end passphrase) "Sign the current buffer. + If the optional argument CLEARTEXT is non-nil, it does not create a detached signature. + If optional arguments START and END are specified, only sign data within the region. + If this function is called interactively, CLEARTEXT is enabled -and the the output is displayed." +and the the output is displayed. + +If optional PASSPHRASE is not specified, it will be obtained from the +passphrase cache or user." (interactive "") (let* ((start (or start (point-min))) (end (or end (point-max))) - (status (pgg-sign-region start end (or (interactive-p) cleartext)))) + (status (pgg-sign-region start end + (or (interactive-p) cleartext) + passphrase))) (when (interactive-p) (pgg-display-output-buffer start end status)) status)) - + ;;;###autoload (defun pgg-verify-region (start end &optional signature fetch) "Verify the current region between START and END. Index: pgg-gpg.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/pgg-gpg.el,v retrieving revision 1.1 diff -u -r1.1 pgg-gpg.el --- pgg-gpg.el 24 Oct 2005 09:46:27 -0000 1.1 +++ pgg-gpg.el 25 Oct 2005 20:16:01 -0000 @@ -4,6 +4,7 @@ ;; 2005 Free Software Foundation, Inc. ;; Author: Daiki Ueno +;; Symmetric encryption added by: Sascha Wilde ;; Created: 1999/10/28 ;; Keywords: PGP, OpenPGP, GnuPG @@ -96,19 +97,20 @@ (delete-file output-file-name)) (set-default-file-modes orig-mode)))) -(defun pgg-gpg-possibly-cache-passphrase (passphrase &optional key) +(defun pgg-gpg-possibly-cache-passphrase (passphrase &optional key notruncate) (if (and pgg-cache-passphrase (progn (goto-char (point-min)) (re-search-forward "^\\[GNUPG:] \\(GOOD_PASSPHRASE\\>\\)\\|\\(SIG_CREATED\\)" nil t))) - (pgg-add-passphrase-cache + (pgg-add-passphrase-to-cache (or key (progn (goto-char (point-min)) (if (re-search-forward "^\\[GNUPG:] NEED_PASSPHRASE\\(_PIN\\)? \\w+ ?\\w*" nil t) (substring (match-string 0) -8)))) - passphrase))) + passphrase + notruncate))) (defvar pgg-gpg-all-secret-keys 'unknown) @@ -139,18 +141,53 @@ nil t) (substring (match-string 2) 8))))) -(defun pgg-gpg-encrypt-region (start end recipients &optional sign) +(defun pgg-gpg-lookup-key-owner (string &optional all) + "Search keys associated with STRING and return owner of identified key. + +The value may be just the bare key id, or it may be a combination of the +user name associated with the key and the key id, with the key id enclosed +in \"<...>\" angle brackets. + +Optional ALL non-nil means search all keys, including secret keys." + (let ((args (list "--with-colons" "--no-greeting" "--batch" + (if all "--list-secret-keys" "--list-keys") + string)) + (key-regexp (concat "^\\(sec\\|pub\\)" + ":[^:]*:[^:]*:[^:]*:\\([^:]*\\):[^:]*" + ":[^:]*:[^:]*:[^:]*:\\([^:]*\\):")) + ) + (with-temp-buffer + (apply #'call-process pgg-gpg-program nil t nil args) + (goto-char (point-min)) + (if (re-search-forward key-regexp + nil t) + (match-string 3))))) + +(defun pgg-gpg-key-id-from-key-owner (key-owner) + (cond ((not key-owner) nil) + ;; Extract bare key id from outermost paired angle brackets, if any: + ((string-match "[^<]*<\\(.+\\)>[^>]*" key-owner) + (substring key-owner (match-beginning 1)(match-end 1))) + (key-owner)) + ) + +(defun pgg-gpg-encrypt-region (start end recipients &optional sign passphrase) "Encrypt the current region between START and END. -If optional argument SIGN is non-nil, do a combined sign and encrypt." + +If optional argument SIGN is non-nil, do a combined sign and encrypt. + +If optional PASSPHRASE is not specified, it will be obtained from the +passphrase cache or user." (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) - (passphrase - (when sign - (pgg-read-passphrase - (format "GnuPG passphrase for %s: " pgg-gpg-user-id) - pgg-gpg-user-id))) + (passphrase (or passphrase + (when sign + (pgg-read-passphrase + (format "GnuPG passphrase for %s: " + pgg-gpg-user-id) + pgg-gpg-user-id)))) (args (append - (list "--batch" "--armor" "--always-trust" "--encrypt") + (list "--batch" "--textmode" "--armor" "--always-trust" "--encrypt") (if sign (list "--sign" "--local-user" pgg-gpg-user-id)) (if recipients (apply #'nconc @@ -169,19 +206,46 @@ (pgg-gpg-possibly-cache-passphrase passphrase))) (pgg-process-when-success))) -(defun pgg-gpg-decrypt-region (start end) - "Decrypt the current region between START and END." +(defun pgg-gpg-encrypt-symmetric-region (start end &optional passphrase) + "Encrypt the current region between START and END with symmetric cipher. + +If optional PASSPHRASE is not specified, it will be obtained from the +passphrase cache or user." + (let* ((passphrase (or passphrase + (pgg-read-passphrase + "GnuPG passphrase for symmetric encryption: "))) + (args + (append (list "--batch" "--textmode" "--armor" "--symmetric" )))) + (pgg-as-lbt start end 'CRLF + (pgg-gpg-process-region start end passphrase pgg-gpg-program args)) + (pgg-process-when-success))) + +(defun pgg-gpg-decrypt-region (start end &optional passphrase) + "Decrypt the current region between START and END. + +If optional PASSPHRASE is not specified, it will be obtained from the +passphrase cache or user." (let* ((current-buffer (current-buffer)) (message-keys (with-temp-buffer (insert-buffer-substring current-buffer) (pgg-decode-armor-region (point-min) (point-max)))) (secret-keys (pgg-gpg-lookup-all-secret-keys)) + ;; XXX the user is stuck if they need to use the passphrase for + ;; any but the first secret key for which the message is + ;; encrypted. ideally, we would incrementally give them a + ;; chance with subsequent keys each time they fail with one. (key (pgg-gpg-select-matching-key message-keys secret-keys)) - (pgg-gpg-user-id (or key pgg-gpg-user-id pgg-default-user-id)) - (passphrase - (pgg-read-passphrase - (format "GnuPG passphrase for %s: " pgg-gpg-user-id) - pgg-gpg-user-id)) + (key-owner (and key (pgg-gpg-lookup-key-owner key t))) + (key-id (pgg-gpg-key-id-from-key-owner key-owner)) + (pgg-gpg-user-id (or key-id key + pgg-gpg-user-id pgg-default-user-id)) + (passphrase (or passphrase + (pgg-read-passphrase + (format (if (pgg-gpg-symmetric-key-p message-keys) + "Passphrase for symmetric decryption: " + "GnuPG passphrase for %s: ") + (or key-owner "??")) + pgg-gpg-user-id))) (args '("--batch" "--decrypt"))) (pgg-gpg-process-region start end passphrase pgg-gpg-program args) (with-current-buffer pgg-errors-buffer @@ -189,21 +253,31 @@ (goto-char (point-min)) (re-search-forward "^\\[GNUPG:] DECRYPTION_OKAY\\>" nil t)))) +;;;###autoload +(defun pgg-gpg-symmetric-key-p (message-keys) + "True if decoded armor MESSAGE-KEYS has symmetric encryption indicator." + (let (result) + (dolist (key message-keys result) + (when (and (eq (car key) 3) + (member '(symmetric-key-algorithm) key)) + (setq result key))))) + (defun pgg-gpg-select-matching-key (message-keys secret-keys) "Choose a key from MESSAGE-KEYS that matches one of the keys in SECRET-KEYS." (loop for message-key in message-keys for message-key-id = (and (equal (car message-key) 1) - (cdr (assq 'key-identifier message-key))) + (cdr (assq 'key-identifier + (cdr message-key)))) for key = (and message-key-id (pgg-lookup-key message-key-id 'encrypt)) when (and key (member key secret-keys)) return key)) -(defun pgg-gpg-sign-region (start end &optional cleartext) +(defun pgg-gpg-sign-region (start end &optional cleartext passphrase) "Make detached signature from text between START and END." (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) - (passphrase - (pgg-read-passphrase - (format "GnuPG passphrase for %s: " pgg-gpg-user-id) - pgg-gpg-user-id)) + (passphrase (or passphrase + (pgg-read-passphrase + (format "GnuPG passphrase for %s: " pgg-gpg-user-id) + pgg-gpg-user-id))) (args (list (if cleartext "--clearsign" "--detach-sign") "--armor" "--batch" "--verbose" ------=_Part_58195_6127455.1130275717869 Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ Emacs-devel mailing list Emacs-devel@gnu.org http://lists.gnu.org/mailman/listinfo/emacs-devel ------=_Part_58195_6127455.1130275717869--