X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=epg.el;h=85bb3fa52c92ba4066f2a4192b53fa0a030f1d2d;hb=c1babcf7986279159bdb80e02726adf8c96cae83;hp=4fbf59b4c8e82e9f6560496a46c1b65af3527514;hpb=afd2746e0783b9c31a72de989103f6e7c3f3ecb7;p=elisp%2Fepg.git diff --git a/epg.el b/epg.el index 4fbf59b..85bb3fa 100644 --- a/epg.el +++ b/epg.el @@ -25,21 +25,7 @@ ;;; Code: -(defgroup epg () - "The EasyPG Library" - :group 'emacs) - -(defcustom epg-gpg-program "gpg" - "The `gpg' executable." - :group 'epg - :type 'string) - -(defcustom epg-gpgsm-program "gpgsm" - "The `gpgsm' executable." - :group 'epg - :type 'string) - -(defconst epg-version-number "0.0.1") +(require 'epg-config) (defvar epg-user-id nil "GnuPG ID of your default identity.") @@ -48,10 +34,10 @@ "An alist mapping from key ID to user ID.") (defvar epg-read-point nil) +(defvar epg-process-filter-running nil) (defvar epg-pending-status-list nil) (defvar epg-key-id nil) (defvar epg-context nil) -(defvar epg-debug nil) (defvar epg-debug-buffer nil) ;; from gnupg/include/cipher.h @@ -200,7 +186,7 @@ (vector (or protocol 'OpenPGP) armor textmode include-certs cipher-algorithm digest-algorithm compress-algorithm #'epg-passphrase-callback-function - #'epg-progress-callback-function + nil nil nil nil nil nil))) (defun epg-context-protocol (context) @@ -759,15 +745,14 @@ This function is for internal use only." ((eq (epg-signature-status signature) 'no-pubkey) "No public key for ")) (epg-signature-key-id signature) - " " (if user-id - (concat (if (stringp user-id) + (concat " " + (if (stringp user-id) user-id - (epg-decode-dn user-id)) - " ") + (epg-decode-dn user-id))) "") (if (epg-signature-validity signature) - (format "(trust %s)" (epg-signature-validity signature)) + (format " (trust %s)" (epg-signature-validity signature)) "")))) (defun epg-verify-result-to-string (verify-result) @@ -803,6 +788,10 @@ This function is for internal use only." (let* ((args (append (list "--no-tty" "--status-fd" "1" "--yes") + (if (epg-context-progress-callback context) + (list "--enable-progress-filter")) + (if epg-gpg-home-directory + (list "--homedir" epg-gpg-home-directory)) (unless (eq (epg-context-protocol context) 'CMS) (list "--command-fd" "0")) (if (epg-context-armor context) '("--armor")) @@ -829,6 +818,8 @@ This function is for internal use only." (with-current-buffer buffer (make-local-variable 'epg-read-point) (setq epg-read-point (point-min)) + (make-local-variable 'epg-process-filter-running) + (setq epg-process-filter-running nil) (make-local-variable 'epg-pending-status-list) (setq epg-pending-status-list nil) (make-local-variable 'epg-key-id) @@ -861,21 +852,26 @@ This function is for internal use only." (set-buffer (process-buffer process)) (goto-char (point-max)) (insert input) - (goto-char epg-read-point) - (beginning-of-line) - (while (looking-at ".*\n") ;the input line finished - (save-excursion - (if (looking-at "\\[GNUPG:] \\([A-Z_]+\\) ?\\(.*\\)") - (let* ((status (match-string 1)) - (string (match-string 2)) - (symbol (intern-soft (concat "epg--status-" status)))) - (if (member status epg-pending-status-list) - (setq epg-pending-status-list nil)) - (if (and symbol - (fboundp symbol)) - (funcall symbol epg-context string))))) - (forward-line)) - (setq epg-read-point (point))))) + (unless epg-process-filter-running + (unwind-protect + (progn + (setq epg-process-filter-running t) + (goto-char epg-read-point) + (beginning-of-line) + (while (looking-at ".*\n") ;the input line finished + (if (looking-at "\\[GNUPG:] \\([A-Z_]+\\) ?\\(.*\\)") + (let* ((status (match-string 1)) + (string (match-string 2)) + (symbol (intern-soft (concat "epg--status-" + status)))) + (if (member status epg-pending-status-list) + (setq epg-pending-status-list nil)) + (if (and symbol + (fboundp symbol)) + (funcall symbol epg-context string)))) + (forward-line) + (setq epg-read-point (point)))) + (setq epg-process-filter-running nil)))))) (defun epg-read-output (context) "Read the output file CONTEXT and return the content as a string." @@ -934,39 +930,55 @@ This function is for internal use only." (setq epg-key-id 'PIN)) (defun epg--status-GET_HIDDEN (context string) - (if (and epg-key-id - (string-match "\\`passphrase\\." string)) - (let (inhibit-quit - passphrase - passphrase-with-new-line) - (unwind-protect - (condition-case nil - (progn - (setq passphrase - (funcall - (if (consp (epg-context-passphrase-callback context)) - (car (epg-context-passphrase-callback context)) - (epg-context-passphrase-callback context)) - context - epg-key-id - (if (consp (epg-context-passphrase-callback context)) - (cdr (epg-context-passphrase-callback context))))) - (when passphrase - (setq passphrase-with-new-line (concat passphrase "\n")) - (fillarray passphrase 0) - (setq passphrase nil) - (process-send-string (epg-context-process context) - passphrase-with-new-line))) - (quit - (epg-context-set-result-for - context 'error - (cons '(quit) - (epg-context-result-for context 'error))) - (delete-process (epg-context-process context)))) - (if passphrase - (fillarray passphrase 0)) - (if passphrase-with-new-line - (fillarray passphrase-with-new-line 0)))))) + (when (and epg-key-id + (string-match "\\`passphrase\\." string)) + (unless (epg-context-passphrase-callback context) + (error "passphrase-callback not set")) + (let (inhibit-quit + passphrase + passphrase-with-new-line + encoded-passphrase-with-new-line) + (unwind-protect + (condition-case nil + (progn + (setq passphrase + (funcall + (if (consp (epg-context-passphrase-callback context)) + (car (epg-context-passphrase-callback context)) + (epg-context-passphrase-callback context)) + context + epg-key-id + (if (consp (epg-context-passphrase-callback context)) + (cdr (epg-context-passphrase-callback context))))) + (when passphrase + (setq passphrase-with-new-line (concat passphrase "\n")) + (epg--clear-string passphrase) + (setq passphrase nil) + (if epg-passphrase-coding-system + (progn + (setq encoded-passphrase-with-new-line + (encode-coding-string + passphrase-with-new-line + epg-passphrase-coding-system)) + (epg--clear-string passphrase-with-new-line) + (setq passphrase-with-new-line nil)) + (setq encoded-passphrase-with-new-line + passphrase-with-new-line + passphrase-with-new-line nil)) + (process-send-string (epg-context-process context) + encoded-passphrase-with-new-line))) + (quit + (epg-context-set-result-for + context 'error + (cons '(quit) + (epg-context-result-for context 'error))) + (delete-process (epg-context-process context)))) + (if passphrase + (epg--clear-string passphrase)) + (if passphrase-with-new-line + (epg--clear-string passphrase-with-new-line)) + (if encoded-passphrase-with-new-line + (epg--clear-string encoded-passphrase-with-new-line)))))) (defun epg--status-GET_BOOL (context string) (let ((entry (assoc string epg-prompt-alist)) @@ -1055,7 +1067,11 @@ This function is for internal use only." \\([0-9A-Fa-f][0-9A-Fa-f]\\) \\([^ ]+\\) \\([0-9]+\\)" string) (let ((signature (epg-make-signature 'error))) - (epg-context-set-result-for context 'verify (list signature)) + (epg-context-set-result-for + context + 'verify + (cons signature + (epg-context-result-for context 'verify))) (epg-signature-set-key-id signature (match-string 1 string)) @@ -1292,30 +1308,14 @@ This function is for internal use only." (defun epg-progress-callback-function (context what char current total handback) - (message "%s: %d%%/%d%%" what current total)) - -(defun epg-configuration () - "Return a list of internal configuration parameters of `epg-gpg-program'." - (let (config type) - (with-temp-buffer - (apply #'call-process epg-gpg-program nil (list t nil) nil - '("--with-colons" "--list-config")) - (goto-char (point-min)) - (while (re-search-forward "^cfg:\\([^:]+\\):\\(.*\\)" nil t) - (setq type (intern (match-string 1)) - config (cons (cons type - (if (memq type - '(pubkey cipher digest compress)) - (mapcar #'string-to-number - (delete "" (split-string - (match-string 2) - ";"))) - (match-string 2))) - config)))) - config)) + (message "%s: %d%% (%d/%d)" what + (if (> total 0) (floor (* (/ current (float total)) 100)) 0) + current total)) (defun epg--list-keys-1 (context name mode) - (let ((args (append (list "--with-colons" "--no-greeting" "--batch" + (let ((args (append (if epg-gpg-home-directory + (list "--homedir" epg-gpg-home-directory)) + (list "--with-colons" "--no-greeting" "--batch" "--with-fingerprint" "--with-fingerprint" (if (memq mode '(t secret)) @@ -1492,6 +1492,11 @@ You can then use `write-region' to write new data into the file." (file-directory-p tempdir) (delete-directory tempdir)))))) +(if (fboundp 'clear-string) + (defalias 'epg--clear-string 'clear-string) + (defun epg--clear-string (string) + (fillarray string 0))) + ;;;###autoload (defun epg-cancel (context) (if (buffer-live-p (process-buffer (epg-context-process context))) @@ -1507,7 +1512,7 @@ You can then use `write-region' to write new data into the file." ;;;###autoload (defun epg-start-decrypt (context cipher) "Initiate a decrypt operation on CIPHER. -CIPHER is a data object. +CIPHER must be a file data object. If you use this function, you will need to wait for the completion of `epg-gpg-program' by using `epg-wait-for-completion' and call @@ -1518,7 +1523,7 @@ If you are unsure, use synchronous version of this function (error "Not a file")) (epg-context-set-operation context 'decrypt) (epg-context-set-result context nil) - (epg--start context (list "--decrypt" (epg-data-file cipher))) + (epg--start context (list "--decrypt" "--" (epg-data-file cipher))) ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed. (unless (eq (epg-context-protocol context) 'CMS) (epg-wait-for-status context '("BEGIN_DECRYPTION")))) @@ -1583,9 +1588,10 @@ If you are unsure, use synchronous version of this function (if signed-text ;; Detached signature. (if (epg-data-file signed-text) - (epg--start context (list "--verify" (epg-data-file signature) + (epg--start context (list "--verify" "--" (epg-data-file signature) (epg-data-file signed-text))) - (epg--start context (list "--verify" (epg-data-file signature) "-")) + (epg--start context (list "--verify" "--" (epg-data-file signature) + "-")) (if (eq (process-status (epg-context-process context)) 'run) (process-send-string (epg-context-process context) (epg-data-string signed-text))) @@ -1593,7 +1599,7 @@ If you are unsure, use synchronous version of this function (process-send-eof (epg-context-process context)))) ;; Normal (or cleartext) signature. (if (epg-data-file signature) - (epg--start context (list "--verify" (epg-data-file signature))) + (epg--start context (list "--verify" "--" (epg-data-file signature))) (epg--start context (list "--verify")) (if (eq (process-status (epg-context-process context)) 'run) (process-send-string (epg-context-process context) @@ -1692,7 +1698,7 @@ If you are unsure, use synchronous version of this function (car (epg-key-sub-key-list signer))))) (epg-context-signers context))) (if (epg-data-file plain) - (list (epg-data-file plain))))) + (list "--" (epg-data-file plain))))) ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed. (unless (eq (epg-context-protocol context) 'CMS) (epg-wait-for-status context '("BEGIN_SIGNING"))) @@ -1770,9 +1776,13 @@ If you are unsure, use synchronous version of this function (if sign (cons "--sign" (apply #'nconc - (mapcar (lambda (signer) - (list "-u" signer)) - (epg-context-signers context))))) + (mapcar + (lambda (signer) + (list "-u" + (epg-sub-key-id + (car (epg-key-sub-key-list + signer))))) + (epg-context-signers context))))) (apply #'nconc (mapcar (lambda (recipient) @@ -1781,7 +1791,7 @@ If you are unsure, use synchronous version of this function (car (epg-key-sub-key-list recipient))))) recipients)) (if (epg-data-file plain) - (list (epg-data-file plain))))) + (list "--" (epg-data-file plain))))) ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed. (unless (eq (epg-context-protocol context) 'CMS) (if sign @@ -1905,7 +1915,7 @@ If you are unsure, use synchronous version of this function (epg-context-set-operation context 'import-keys) (epg-context-set-result context nil) (epg--start context (if (epg-data-file keys) - (list "--import" (epg-data-file keys)) + (list "--import" "--" (epg-data-file keys)) (list "--import"))) (when (epg-data-string keys) (if (eq (process-status (epg-context-process context)) 'run) @@ -2041,7 +2051,7 @@ If you are unsure, use synchronous version of this function (epg-context-set-operation context 'generate-key) (epg-context-set-result context nil) (if (epg-data-file parameters) - (epg--start context (list "--batch" "--genkey" + (epg--start context (list "--batch" "--genkey" "--" (epg-data-file parameters))) (epg--start context '("--batch" "--genkey")) (if (eq (process-status (epg-context-process context)) 'run)