From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Daiki Ueno Newsgroups: gmane.emacs.devel,gmane.emacs.gnus.general Subject: Re: Small patch to enable use of gpg-agent with pgg Date: Sun, 26 Mar 2006 09:29:32 +0900 Message-ID: References: <2cd46e7f0510031250u66ea1349yb437d539ce4027ef@mail.gmail.com> <20051007214952.GA30235@kenny.sha-bang.local> <20051008103627.GA1218@kenny.sha-bang.local> <2cd46e7f0510081131h14e2bbeaga7f1a33ebd6347c8@mail.gmail.com> <2cd46e7f0510101415t76825ea7u9749fe23da54ce@mail.gmail.com> <2cd46e7f0510121647x3c51fb65pc883ed61f4e864ab@mail.gmail.com> <2cd46e7f0510200708x4640d1c2t50743cf439e52dd4@mail.gmail.com> <87pskfq361.fsf@latte.josefsson.org> <877j6mg2af.fsf@latte.josefsson.org> <87lkv1whmh.fsf@latte.josefsson.org> <897751e5-a148-4109-8da6-6f69cce0dec0@well-done.deisui.org> <87d5gd2ts1.fsf@latte.josefsson.org> NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="Multipart_Sun_Mar_26_09:29:32_2006-1" X-Trace: sea.gmane.org 1143332992 17497 80.91.229.2 (26 Mar 2006 00:29:52 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Sun, 26 Mar 2006 00:29:52 +0000 (UTC) Cc: Sascha Wilde , ding@gnus.org, emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sun Mar 26 01:29:49 2006 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by ciao.gmane.org with esmtp (Exim 4.43) id 1FNJ8d-00054K-5o for ged-emacs-devel@m.gmane.org; Sun, 26 Mar 2006 01:29:47 +0100 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1FNJ8c-0007u7-8e for ged-emacs-devel@m.gmane.org; Sat, 25 Mar 2006 19:29:46 -0500 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1FNJ8I-0007tq-Fd for emacs-devel@gnu.org; Sat, 25 Mar 2006 19:29:26 -0500 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1FNJ8F-0007tM-R0 for emacs-devel@gnu.org; Sat, 25 Mar 2006 19:29:25 -0500 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1FNJ8F-0007t9-Ni for emacs-devel@gnu.org; Sat, 25 Mar 2006 19:29:23 -0500 Original-Received: from [221.255.76.220] (helo=localhost) by monty-python.gnu.org with esmtps (TLS-1.0:RSA_AES_256_CBC_SHA:32) (Exim 4.52) id 1FNJ9O-0005Ei-UX for emacs-devel@gnu.org; Sat, 25 Mar 2006 19:30:35 -0500 Original-Received: from localhost ([127.0.0.1] helo=well-done.deisui.org ident=ueno) by localhost with esmtp (Exim 4.60) (envelope-from ) id 1FNJ8O-0006qu-GN; Sun, 26 Mar 2006 09:29:32 +0900 Original-To: Simon Josefsson X-Attribution: DU In-Reply-To: (Daiki Ueno's message of "Fri, 24 Mar 2006 14:51:05 +0900") User-Agent: T-gnus/6.17.3 (based on No Gnus v0.3) SEMI/1.14.6 (Maruoka) FLIM/1.14.8 (=?ISO-8859-4?Q?Shij=F2?=) APEL/10.6 XEmacs/21.4.16 (i686-pc-linux) MULE 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:52061 gmane.emacs.gnus.general:62403 Archived-At: --Multipart_Sun_Mar_26_09:29:32_2006-1 Content-Type: text/plain; charset=US-ASCII >>>>> In >>>>> Daiki Ueno wrote: > > Maybe you can finish this code, and I can debug why it doesn't work > > for a smartcard separately. It is probably not an important feature. > The new code mostly finished. Ok, the attached file is (hopefully) the final version of the new code. Differences from the previous one are: - Passphrase caching now works again. - pgg-gpg-use-agent is abolished. Add "use-agent" to ~/.gnupg/gpg.conf if you want to enable use of gpg-agent, as Miles said. - Tested with typical cases. I also attach some test cases I used. --Multipart_Sun_Mar_26_09:29:32_2006-1 Content-Type: application/octet-stream; type=emacs-lisp Content-Disposition: attachment; filename="pgg-gpg.el" Content-Transfer-Encoding: 7bit ;;; pgg-gpg.el --- GnuPG support for PGG. ;; Copyright (C) 1999, 2000, 2002, 2003, 2004, ;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Daiki Ueno ;; Symmetric encryption and gpg-agent support added by: ;; Sascha Wilde ;; Created: 1999/10/28 ;; Keywords: PGP, OpenPGP, GnuPG ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (eval-when-compile (require 'pgg)) (defgroup pgg-gpg () "GnuPG interface." :group 'pgg) (defcustom pgg-gpg-program "gpg" "The GnuPG executable." :group 'pgg-gpg :type 'string) (defcustom pgg-gpg-extra-args nil "Extra arguments for every GnuPG invocation." :group 'pgg-gpg :type '(repeat (string :tag "Argument"))) (defcustom pgg-gpg-recipient-argument "--recipient" "GnuPG option to specify recipient." :group 'pgg-gpg :type '(choice (const :tag "New `--recipient' option" "--recipient") (const :tag "Old `--remote-user' option" "--remote-user"))) (defvar pgg-gpg-user-id nil "GnuPG ID of your default identity.") (defvar pgg-gpg-user-id-alist nil "An alist mapping from key ID to user ID.") (defvar pgg-gpg-read-point nil) (defvar pgg-gpg-output-file-name nil) (defvar pgg-gpg-pending-status-list nil) (defvar pgg-gpg-key-id nil) (defvar pgg-gpg-passphrase nil) (defvar pgg-gpg-debug nil) (defun pgg-gpg-start-process (args) (let* ((output-file-name (pgg-make-temp-file "pgg-output")) (args (append (list "--no-tty" "--status-fd" "1" "--command-fd" "0" "--yes" ; overwrite "--output" output-file-name) pgg-gpg-extra-args args)) (coding-system-for-write 'binary) (process-connection-type nil) (orig-mode (default-file-modes)) default-enable-multibyte-characters (buffer (generate-new-buffer " *pgg-gpg*")) process) (with-current-buffer buffer (make-local-variable 'pgg-gpg-read-point) (setq pgg-gpg-read-point (point-min)) (make-local-variable 'pgg-gpg-output-file-name) (setq pgg-gpg-output-file-name output-file-name) (make-local-variable 'pgg-gpg-pending-status-list) (setq pgg-gpg-pending-status-list nil) (make-local-variable 'pgg-gpg-key-id) (setq pgg-gpg-key-id nil) (make-local-variable 'pgg-gpg-passphrase) (setq pgg-gpg-passphrase nil)) (unwind-protect (progn (set-default-file-modes 448) (setq process (apply #'start-process "pgg-gpg" buffer pgg-gpg-program args))) (set-default-file-modes orig-mode)) (set-process-filter process #'pgg-gpg-process-filter) (set-process-sentinel process #'pgg-gpg-process-sentinel) process)) (defun pgg-gpg-process-filter (process input) (save-excursion (if pgg-gpg-debug (save-excursion (set-buffer (get-buffer-create " *pgg-gpg-debug*")) (goto-char (point-max)) (insert input))) (set-buffer (process-buffer process)) (goto-char (point-max)) (insert input) (goto-char pgg-gpg-read-point) (beginning-of-line) (while (looking-at ".*\n") ;the input line is finished (save-excursion (if (looking-at "\\[GNUPG:] \\([A-Z_]+\\)\\>.*") (let* ((status (match-string 1)) (symbol (intern-soft (concat "pgg-gpg-status-" status))) (entry (member status pgg-gpg-pending-status-list))) (if entry (setq pgg-gpg-pending-status-list (delq (car entry) pgg-gpg-pending-status-list))) (if (and symbol (fboundp symbol)) (funcall symbol process (buffer-substring (match-beginning 1) (match-end 0))))))) (forward-line)) (setq pgg-gpg-read-point (point)))) (defun pgg-gpg-process-sentinel (process status) (set-process-filter process nil) (save-excursion ;; Copy the contents of process-buffer to pgg-errors-buffer. (set-buffer (get-buffer-create pgg-errors-buffer)) (buffer-disable-undo) (erase-buffer) (when (buffer-live-p (process-buffer process)) (insert-buffer-substring (process-buffer process)) (goto-char (point-min)) (delete-matching-lines "^\\[GNUPG:] ") (goto-char (point-min)) (while (re-search-forward "^gpg: " nil t) (replace-match ""))) ;; Read the contents of the output file to pgg-output-buffer. (set-buffer (get-buffer-create pgg-output-buffer)) (buffer-disable-undo) (erase-buffer) (if (and (equal status "finished\n") (buffer-live-p (process-buffer process))) (let ((output-file-name (with-current-buffer (process-buffer process) pgg-gpg-output-file-name))) (when (file-exists-p output-file-name) (let ((coding-system-for-read (if pgg-text-mode 'raw-text 'binary))) (insert-file-contents output-file-name)) (delete-file output-file-name)))))) (defun pgg-gpg-wait-for-status (process status-list) (with-current-buffer (process-buffer process) (setq pgg-gpg-pending-status-list status-list) (while (and (eq (process-status process) 'run) pgg-gpg-pending-status-list) (accept-process-output process 1)))) (defun pgg-gpg-wait-for-completion (process &optional status-list) (process-send-eof process) (while (eq (process-status process) 'run) (sit-for 0.1)) (save-excursion (set-buffer (process-buffer process)) (setq status-list (copy-sequence status-list)) (let ((pointer status-list)) (while pointer (goto-char (point-min)) (unless (re-search-forward (concat "^\\[GNUPG:] " (car pointer) "\\>") nil t) (setq status-list (delq (car pointer) status-list))) (setq pointer (cdr pointer)))) (kill-buffer (process-buffer process)) status-list)) (defun pgg-gpg-status-USERID_HINT (process line) (if (string-match "\\`USERID_HINT \\([^ ]+\\) \\(.*\\)" line) (let* ((key-id (match-string 1 line)) (user-id (match-string 2 line)) (entry (assoc key-id pgg-gpg-user-id-alist))) (if entry (setcdr entry user-id) (setq pgg-gpg-user-id-alist (cons (cons key-id user-id) pgg-gpg-user-id-alist)))))) (defun pgg-gpg-status-NEED_PASSPHRASE (process line) (if (string-match "\\`NEED_PASSPHRASE \\([^ ]+\\)" line) (setq pgg-gpg-key-id (match-string 1 line)))) (defun pgg-gpg-status-NEED_PASSPHRASE_SYM (process line) (setq pgg-gpg-key-id 'SYM)) (defun pgg-gpg-status-NEED_PASSPHRASE_PIN (process line) (setq pgg-gpg-key-id 'PIN)) (defun pgg-gpg-status-GET_HIDDEN (process line) (let ((entry (assoc pgg-gpg-key-id pgg-gpg-user-id-alist))) (if (setq pgg-gpg-passphrase (if (eq pgg-gpg-key-id 'SYM) (pgg-read-passphrase "GnuPG passphrase for symmetric encryption: ") (pgg-read-passphrase (format "GnuPG passphrase for %s: " (if entry (cdr entry) pgg-gpg-key-id)) (if (eq pgg-gpg-key-id 'PIN) "PIN" pgg-gpg-key-id)))) (process-send-string process (concat pgg-gpg-passphrase "\n"))))) (defun pgg-gpg-status-GOOD_PASSPHRASE (process line) (when (and pgg-gpg-passphrase (stringp pgg-gpg-key-id)) (pgg-add-passphrase-to-cache pgg-gpg-key-id pgg-gpg-passphrase) (setq pgg-gpg-passphrase nil))) (defun pgg-gpg-status-BAD_PASSPHRASE (process line) (when pgg-gpg-passphrase (fillarray pgg-gpg-passphrase 0) (setq pgg-gpg-passphrase nil))) (defun pgg-gpg-lookup-key (string &optional type) "Search keys associated with STRING." (let ((args (list "--with-colons" "--no-greeting" "--batch" (if type "--list-secret-keys" "--list-keys") string))) (with-temp-buffer (apply #'call-process pgg-gpg-program nil t nil args) (goto-char (point-min)) (if (re-search-forward "^\\(sec\\|pub\\):[^:]*:[^:]*:[^:]*:\\([^:]*\\)" nil t) (substring (match-string 2) 8))))) (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." (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) (args (append '("--armor" "--always-trust" "--encrypt") (if pgg-text-mode '("--textmode")) (if sign (list "--sign" "--local-user" pgg-gpg-user-id)) (if recipients (apply #'nconc (mapcar (lambda (rcpt) (list pgg-gpg-recipient-argument rcpt)) (append recipients (if pgg-encrypt-for-me (list pgg-gpg-user-id)))))))) (process (pgg-gpg-start-process args))) (if sign (pgg-gpg-wait-for-status process '("GOOD_PASSPHRASE"))) (process-send-region process start end) (pgg-gpg-wait-for-completion process '("SIG_CREATED" "END_ENCRYPTION")))) (defun pgg-gpg-encrypt-symmetric-region (start end &optional passphrase) "Encrypt the current region between START and END with symmetric cipher." (let* ((args (append '("--armor" "--symmetric") (if pgg-text-mode '("--textmode")))) (process (pgg-gpg-start-process args))) (pgg-gpg-wait-for-status process '("BEGIN_ENCRYPTION")) (process-send-region process start end) (pgg-gpg-wait-for-completion process '("END_ENCRYPTION")))) (defun pgg-gpg-decrypt-region (start end &optional passphrase) "Decrypt the current region between START and END." (let* ((args '("--decrypt")) (process (pgg-gpg-start-process args))) (process-send-region process start end) (pgg-gpg-wait-for-status process '("BEGIN_DECRYPTION")) (pgg-gpg-wait-for-completion process '("GOODSIG" "DECRYPTION_OKAY")))) (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)) (args (append (list (if cleartext "--clearsign" "--detach-sign") "--armor" "--verbose" "--local-user" pgg-gpg-user-id) (if pgg-text-mode '("--textmode")))) (process (pgg-gpg-start-process args))) (pgg-gpg-wait-for-status process '("GOOD_PASSPHRASE")) (process-send-region process start end) (pgg-gpg-wait-for-completion process '("SIG_CREATED")))) (defun pgg-gpg-verify-region (start end &optional signature) "Verify region between START and END as the detached signature SIGNATURE." (let ((args '("--verify")) process) (when (stringp signature) (setq args (append args (list signature)))) (setq process (pgg-gpg-start-process (append args '("-")))) (process-send-region process start end) (pgg-gpg-wait-for-completion process '("GOODSIG")))) (defun pgg-gpg-insert-key () "Insert public key at point." (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id)) (args (list "--export" "--armor" pgg-gpg-user-id)) (process (pgg-gpg-start-process args))) (pgg-gpg-wait-for-completion process) (insert-buffer-substring pgg-output-buffer))) (defun pgg-gpg-snarf-keys-region (start end) "Add all public keys in region between START and END to the keyring." (let* ((args '("--import" "-")) (process (pgg-gpg-start-process args)) status) (process-send-region process start end) (pgg-gpg-wait-for-completion process '("IMPORT_RES")))) (provide 'pgg-gpg) ;;; arch-tag: 2aa5d5d8-93a0-4865-9312-33e29830e000 ;;; pgg-gpg.el ends here --Multipart_Sun_Mar_26_09:29:32_2006-1 Content-Type: text/plain; charset=US-ASCII --Multipart_Sun_Mar_26_09:29:32_2006-1 Content-Type: application/octet-stream; type=emacs-lisp Content-Disposition: attachment; filename="test-pgg-gpg.el" Content-Transfer-Encoding: 7bit (require 'pgg) (require 'pgg-gpg) (with-temp-buffer (insert "00000") (pgg-gpg-sign-region (point-min) (point-max) t) (save-excursion (set-buffer pgg-output-buffer) (pgg-gpg-verify-region (point-min) (point-max)))) ;; ("GOODSIG") (with-temp-buffer (insert "00000") (pgg-gpg-encrypt-region (point-min) (point-max) '("ueno@unixuser.org")) (save-excursion (set-buffer pgg-output-buffer) (pgg-gpg-decrypt-region (point-min) (point-max)))) ;; ("DECRYPTION_OKAY") (with-temp-buffer (insert "00000") (pgg-gpg-encrypt-region (point-min) (point-max) '("ueno@unixuser.org") t) (save-excursion (set-buffer pgg-output-buffer) (pgg-gpg-decrypt-region (point-min) (point-max)))) ;; ("GOODSIG" "DECRYPTION_OKAY") (with-temp-buffer (insert "00000") (pgg-gpg-encrypt-symmetric-region (point-min) (point-max)) (save-excursion (set-buffer pgg-output-buffer) (pgg-gpg-decrypt-region (point-min) (point-max)))) ;; ("DECRYPTION_OKAY") --Multipart_Sun_Mar_26_09:29:32_2006-1 Content-Type: text/plain; charset=US-ASCII Regards, -- Daiki Ueno --Multipart_Sun_Mar_26_09:29:32_2006-1 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 --Multipart_Sun_Mar_26_09:29:32_2006-1--