;;; epg.el --- the EasyPG Library -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2000, 2002-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2000, 2002-2014 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG
(defvar epg-key-id nil)
(defvar epg-context nil)
(defvar epg-debug-buffer nil)
+(defvar epg-agent-file nil)
+(defvar epg-agent-mtime nil)
;; from gnupg/include/cipher.h
(defconst epg-cipher-algorithm-alist
(?f . full)
(?u . ultimate)))
-(defvar epg-key-capablity-alist
+(defvar epg-key-capability-alist
'((?e . encrypt)
(?s . sign)
(?c . certify)
(defvar epg-prompt-alist nil)
-(put 'epg-error 'error-conditions '(epg-error error))
+(define-error 'epg-error "GPG error")
(defun epg-make-data-from-file (file)
"Make a data object from FILE."
cipher-algorithm digest-algorithm
compress-algorithm)
"Return a context object."
+ (unless protocol
+ (setq protocol 'OpenPGP))
+ (unless (memq protocol '(OpenPGP CMS))
+ (signal 'epg-error (list "unknown protocol" protocol)))
(cons 'epg-context
- (vector (or protocol 'OpenPGP) armor textmode include-certs
+ (vector protocol
+ (if (eq protocol 'OpenPGP)
+ epg-gpg-program
+ epg-gpgsm-program)
+ epg-gpg-home-directory
+ armor textmode include-certs
cipher-algorithm digest-algorithm compress-algorithm
(list #'epg-passphrase-callback-function)
nil
- nil nil nil nil nil nil)))
+ nil nil nil nil nil nil nil)))
(defun epg-context-protocol (context)
"Return the protocol used within CONTEXT."
(signal 'wrong-type-argument (list 'epg-context-p context)))
(aref (cdr context) 0))
+(defun epg-context-program (context)
+ "Return the gpg or gpgsm executable used within CONTEXT."
+ (unless (eq (car-safe context) 'epg-context)
+ (signal 'wrong-type-argument (list 'epg-context-p context)))
+ (aref (cdr context) 1))
+
+(defun epg-context-home-directory (context)
+ "Return the GnuPG home directory used in CONTEXT."
+ (unless (eq (car-safe context) 'epg-context)
+ (signal 'wrong-type-argument (list 'epg-context-p context)))
+ (aref (cdr context) 2))
+
(defun epg-context-armor (context)
"Return t if the output should be ASCII armored in CONTEXT."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 1))
+ (aref (cdr context) 3))
(defun epg-context-textmode (context)
"Return t if canonical text mode should be used in CONTEXT."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 2))
+ (aref (cdr context) 4))
(defun epg-context-include-certs (context)
"Return how many certificates should be included in an S/MIME signed message."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 3))
+ (aref (cdr context) 5))
(defun epg-context-cipher-algorithm (context)
"Return the cipher algorithm in CONTEXT."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 4))
+ (aref (cdr context) 6))
(defun epg-context-digest-algorithm (context)
"Return the digest algorithm in CONTEXT."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 5))
+ (aref (cdr context) 7))
(defun epg-context-compress-algorithm (context)
"Return the compress algorithm in CONTEXT."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 6))
+ (aref (cdr context) 8))
(defun epg-context-passphrase-callback (context)
"Return the function used to query passphrase."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 7))
+ (aref (cdr context) 9))
(defun epg-context-progress-callback (context)
"Return the function which handles progress update."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 8))
+ (aref (cdr context) 10))
(defun epg-context-signers (context)
"Return the list of key-id for signing."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 9))
+ (aref (cdr context) 11))
(defun epg-context-sig-notations (context)
"Return the list of notations for signing."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 10))
+ (aref (cdr context) 12))
(defun epg-context-process (context)
"Return the process object of `epg-gpg-program'.
This function is for internal use only."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 11))
+ (aref (cdr context) 13))
(defun epg-context-output-file (context)
"Return the output file of `epg-gpg-program'.
This function is for internal use only."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 12))
+ (aref (cdr context) 14))
(defun epg-context-result (context)
"Return the result of the previous cryptographic operation."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 13))
+ (aref (cdr context) 15))
(defun epg-context-operation (context)
"Return the name of the current cryptographic operation."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 14))
+ (aref (cdr context) 16))
+
+(defun epg-context-pinentry-mode (context)
+ "Return the mode of pinentry invocation."
+ (unless (eq (car-safe context) 'epg-context)
+ (signal 'wrong-type-argument (list 'epg-context-p context)))
+ (aref (cdr context) 17))
(defun epg-context-set-protocol (context protocol)
"Set the protocol used within CONTEXT."
(signal 'wrong-type-argument (list 'epg-context-p context)))
(aset (cdr context) 0 protocol))
+(defun epg-context-set-program (context protocol)
+ "Set the gpg or gpgsm executable used within CONTEXT."
+ (unless (eq (car-safe context) 'epg-context)
+ (signal 'wrong-type-argument (list 'epg-context-p context)))
+ (aset (cdr context) 1 protocol))
+
+(defun epg-context-set-home-directory (context directory)
+ "Set the GnuPG home directory."
+ (unless (eq (car-safe context) 'epg-context)
+ (signal 'wrong-type-argument (list 'epg-context-p context)))
+ (aset (cdr context) 2 directory))
+
(defun epg-context-set-armor (context armor)
"Specify if the output should be ASCII armored in CONTEXT."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 1 armor))
+ (aset (cdr context) 3 armor))
(defun epg-context-set-textmode (context textmode)
"Specify if canonical text mode should be used in CONTEXT."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 2 textmode))
+ (aset (cdr context) 4 textmode))
(defun epg-context-set-include-certs (context include-certs)
"Set how many certificates should be included in an S/MIME signed message."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 3 include-certs))
+ (aset (cdr context) 5 include-certs))
(defun epg-context-set-cipher-algorithm (context cipher-algorithm)
"Set the cipher algorithm in CONTEXT."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 4 cipher-algorithm))
+ (aset (cdr context) 6 cipher-algorithm))
(defun epg-context-set-digest-algorithm (context digest-algorithm)
"Set the digest algorithm in CONTEXT."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 5 digest-algorithm))
+ (aset (cdr context) 7 digest-algorithm))
(defun epg-context-set-compress-algorithm (context compress-algorithm)
"Set the compress algorithm in CONTEXT."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 6 compress-algorithm))
+ (aset (cdr context) 8 compress-algorithm))
(defun epg-context-set-passphrase-callback (context
passphrase-callback)
query by itself and Emacs can intercept them."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 7 (if (consp passphrase-callback)
+ (aset (cdr context) 9 (if (consp passphrase-callback)
passphrase-callback
(list passphrase-callback))))
callback data (if any)."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 8 (if (consp progress-callback)
+ (aset (cdr context) 10 (if (consp progress-callback)
progress-callback
(list progress-callback))))
"Set the list of key-id for signing."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 9 signers))
+ (aset (cdr context) 11 signers))
(defun epg-context-set-sig-notations (context notations)
"Set the list of notations for signing."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 10 notations))
+ (aset (cdr context) 12 notations))
(defun epg-context-set-process (context process)
"Set the process object of `epg-gpg-program'.
This function is for internal use only."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 11 process))
+ (aset (cdr context) 13 process))
(defun epg-context-set-output-file (context output-file)
"Set the output file of `epg-gpg-program'.
This function is for internal use only."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 12 output-file))
+ (aset (cdr context) 14 output-file))
(defun epg-context-set-result (context result)
"Set the result of the previous cryptographic operation."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 13 result))
+ (aset (cdr context) 15 result))
(defun epg-context-set-operation (context operation)
"Set the name of the current cryptographic operation."
(unless (eq (car-safe context) 'epg-context)
(signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 14 operation))
+ (aset (cdr context) 16 operation))
+
+(defun epg-context-set-pinentry-mode (context mode)
+ "Set the mode of pinentry invocation."
+ (unless (eq (car-safe context) 'epg-context)
+ (signal 'wrong-type-argument (list 'epg-context-p context)))
+ (unless (memq mode '(nil ask cancel error loopback))
+ (signal 'epg-error (list "Unknown pinentry mode" mode)))
+ (aset (cdr context) 17 mode))
(defun epg-make-signature (status &optional key-id)
"Return a signature object."
"Convert SIGNATURE to a human readable string."
(let* ((user-id (cdr (assoc (epg-signature-key-id signature)
epg-user-id-alist)))
- (pubkey-algorithm (epg-signature-pubkey-algorithm signature)))
+ (pubkey-algorithm (epg-signature-pubkey-algorithm signature))
+ (key-id (epg-signature-key-id signature)))
(concat
(cond ((eq (epg-signature-status signature) 'good)
"Good signature from ")
"Signature made by revoked key ")
((eq (epg-signature-status signature) 'no-pubkey)
"No public key for "))
- (epg-signature-key-id signature)
+ key-id
(if user-id
(concat " "
(if (stringp user-id)
((eq (car error) 'exit)
"Exit")
((eq (car error) 'quit)
- "Cancelled")
+ "Canceled")
((eq (car error) 'no-data)
(let ((entry (assq (cdr error) epg-no-data-reason-alist)))
(if entry
(if (and (epg-context-process context)
(eq (process-status (epg-context-process context)) 'run))
(error "%s is already running in this context"
- (if (eq (epg-context-protocol context) 'CMS)
- epg-gpgsm-program
- epg-gpg-program)))
- (let* ((args (append (list "--no-tty"
+ (epg-context-program context)))
+ (let* ((agent-info (getenv "GPG_AGENT_INFO"))
+ (args (append (list "--no-tty"
"--status-fd" "1"
"--yes")
(if (and (not (eq (epg-context-protocol context) 'CMS))
- (string-match ":" (or (getenv "GPG_AGENT_INFO")
- "")))
+ (string-match ":" (or agent-info "")))
'("--use-agent"))
(if (and (not (eq (epg-context-protocol context) 'CMS))
(epg-context-progress-callback context))
'("--enable-progress-filter"))
- (if epg-gpg-home-directory
- (list "--homedir" epg-gpg-home-directory))
+ (if (epg-context-home-directory context)
+ (list "--homedir"
+ (epg-context-home-directory context)))
(unless (eq (epg-context-protocol context) 'CMS)
'("--command-fd" "0"))
(if (epg-context-armor context) '("--armor"))
(if (epg-context-textmode context) '("--textmode"))
(if (epg-context-output-file context)
(list "--output" (epg-context-output-file context)))
+ (if (epg-context-pinentry-mode context)
+ (list "--pinentry-mode"
+ (symbol-name (epg-context-pinentry-mode
+ context))))
args))
(coding-system-for-write 'binary)
(coding-system-for-read 'binary)
process-connection-type
+ (process-environment process-environment)
(orig-mode (default-file-modes))
(buffer (generate-new-buffer " *epg*"))
- process)
+ process
+ terminal-name
+ agent-file
+ (agent-mtime '(0 0 0 0)))
+ ;; Set GPG_TTY and TERM for pinentry-curses. Note that we can't
+ ;; use `terminal-name' here to get the real pty name for the child
+ ;; process, though /dev/fd/0" is not portable.
+ (unless (memq system-type '(ms-dos windows-nt))
+ (with-temp-buffer
+ (condition-case nil
+ (when (= (call-process "tty" "/dev/fd/0" t) 0)
+ (delete-char -1)
+ (setq terminal-name (buffer-string)))
+ (file-error))))
+ (when terminal-name
+ (setq process-environment
+ (cons (concat "GPG_TTY=" terminal-name)
+ (cons "TERM=xterm" process-environment))))
+ ;; Record modified time of gpg-agent socket to restore the Emacs
+ ;; frame on text terminal in `epg-wait-for-completion'.
+ ;; See
+ ;; <http://lists.gnu.org/archive/html/emacs-devel/2007-02/msg00755.html>
+ ;; for more details.
+ (when (and agent-info (string-match "\\(.*\\):[0-9]+:[0-9]+" agent-info))
+ (setq agent-file (match-string 1 agent-info)
+ agent-mtime (or (nth 5 (file-attributes agent-file)) '(0 0 0 0))))
(if epg-debug
(save-excursion
(unless epg-debug-buffer
(setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
(set-buffer epg-debug-buffer)
(goto-char (point-max))
- (insert (format "%s %s\n"
- (if (eq (epg-context-protocol context) 'CMS)
- epg-gpgsm-program
- epg-gpg-program)
+ (insert (if agent-info
+ (format "GPG_AGENT_INFO=%s\n" agent-info)
+ "GPG_AGENT_INFO is not set\n")
+ (format "%s %s\n"
+ (epg-context-program context)
(mapconcat #'identity args " ")))))
(with-current-buffer buffer
(if (fboundp 'set-buffer-multibyte)
(make-local-variable 'epg-key-id)
(setq epg-key-id nil)
(make-local-variable 'epg-context)
- (setq epg-context context))
+ (setq epg-context context)
+ (make-local-variable 'epg-agent-file)
+ (setq epg-agent-file agent-file)
+ (make-local-variable 'epg-agent-mtime)
+ (setq epg-agent-mtime agent-mtime))
(unwind-protect
(progn
(set-default-file-modes 448)
(setq process
(apply #'start-process "epg" buffer
- (if (eq (epg-context-protocol context) 'CMS)
- epg-gpgsm-program
- epg-gpg-program)
+ (epg-context-program context)
args)))
(set-default-file-modes orig-mode))
(set-process-filter process #'epg--process-filter)
(defun epg--process-filter (process input)
(if epg-debug
- (save-excursion
- (unless epg-debug-buffer
- (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
- (set-buffer epg-debug-buffer)
+ (with-current-buffer
+ (or epg-debug-buffer
+ (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
(goto-char (point-max))
(insert input)))
(if (buffer-live-p (process-buffer process))
(with-current-buffer (process-buffer process)
- (goto-char (point-max))
- (insert input)
- (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))
- (setq epg-last-status (cons status string))))
- (forward-line)
- (setq epg-read-point (point))))
- (setq epg-process-filter-running nil))))))
+ (save-excursion
+ (goto-char (point-max))
+ (insert input)
+ (unless epg-process-filter-running
+ (let ((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))
+ (setq epg-last-status (cons status string))))
+ (forward-line)
+ (setq epg-read-point (point)))))))))
(defun epg-read-output (context)
"Read the output file CONTEXT and return the content as a string."
(accept-process-output (epg-context-process context) 1))
;; This line is needed to run the process-filter right now.
(sleep-for 0.1)
+ ;; Restore Emacs frame on text terminal, when pinentry-curses has terminated.
+ (if (with-current-buffer (process-buffer (epg-context-process context))
+ (and epg-agent-file
+ (> (float-time (or (nth 5 (file-attributes epg-agent-file))
+ '(0 0 0 0)))
+ (float-time epg-agent-mtime))))
+ (redraw-frame))
(epg-context-set-result-for
context 'error
(nreverse (epg-context-result-for context 'error))))
(epg-context-set-result-for context 'import-status nil)))
(defun epg-passphrase-callback-function (context key-id _handback)
+ (declare (obsolete epa-passphrase-callback-function "23.1"))
(if (eq key-id 'SYM)
(read-passwd "Passphrase for symmetric encryption: "
(eq (epg-context-operation context) 'encrypt))
(format "Passphrase for %s %s: " key-id (cdr entry))
(format "Passphrase for %s: " key-id)))))))
-(make-obsolete 'epg-passphrase-callback-function
- 'epa-passphrase-callback-function "23.1")
-
(defun epg--list-keys-1 (context name mode)
- (let ((args (append (if epg-gpg-home-directory
- (list "--homedir" epg-gpg-home-directory))
+ (let ((args (append (if (epg-context-home-directory context)
+ (list "--homedir"
+ (epg-context-home-directory context)))
'("--with-colons" "--no-greeting" "--batch"
"--with-fingerprint" "--with-fingerprint")
(unless (eq (epg-context-protocol context) 'CMS)
(setq args (append args (list list-keys-option))))
(with-temp-buffer
(apply #'call-process
- (if (eq (epg-context-protocol context) 'CMS)
- epg-gpgsm-program
- epg-gpg-program)
+ (epg-context-program context)
nil (list t nil) nil args)
(goto-char (point-min))
(while (re-search-forward "^[a-z][a-z][a-z]:.*" nil t)
(if (aref line 1)
(cdr (assq (string-to-char (aref line 1)) epg-key-validity-alist)))
(delq nil
- (mapcar (lambda (char) (cdr (assq char epg-key-capablity-alist)))
+ (mapcar (lambda (char) (cdr (assq char epg-key-capability-alist)))
(aref line 11)))
(member (aref line 0) '("sec" "ssb"))
(string-to-number (aref line 3))
For a detached signature, both SIGNATURE and SIGNED-TEXT should be
string. For a normal or a cleartext signature, SIGNED-TEXT should be
nil. In the latter case, if PLAIN is specified, the plaintext is
-stored into the file after successful verification."
+stored into the file after successful verification.
+
+Note that this function does not return verification result as t
+or nil, nor signal error on failure. That's a design decision to
+handle the case where SIGNATURE has multiple signature.
+
+To check the verification results, use `epg-context-result-for' as follows:
+
+\(epg-context-result-for context 'verify)
+
+which will return a list of `epg-signature' object."
(unwind-protect
(progn
(if plain
For a detached signature, both SIGNATURE and SIGNED-TEXT should be
string. For a normal or a cleartext signature, SIGNED-TEXT should be
nil. In the latter case, this function returns the plaintext after
-successful verification."
+successful verification.
+
+Note that this function does not return verification result as t
+or nil, nor signal error on failure. That's a design decision to
+handle the case where SIGNATURE has multiple signature.
+
+To check the verification results, use `epg-context-result-for' as follows:
+
+\(epg-context-result-for context 'verify)
+
+which will return a list of `epg-signature' object."
(let ((coding-system-for-write 'binary)
input-file)
(unwind-protect
(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
- (epg-wait-for-status context '("BEGIN_SIGNING"))
- (epg-wait-for-status context '("BEGIN_ENCRYPTION"))))
+ (epg-wait-for-status context
+ (if sign '("BEGIN_SIGNING") '("BEGIN_ENCRYPTION"))))
(when (epg-data-string plain)
(if (eq (process-status (epg-context-process context)) 'run)
(process-send-string (epg-context-process context)
`epg-reset' to clear a temporary output file.
If you are unsure, use synchronous version of this function
`epg-sign-keys' instead."
+ (declare (obsolete nil "23.1"))
(epg-context-set-operation context 'sign-keys)
(epg-context-set-result context nil)
(epg--start context (cons (if local
(epg-sub-key-id
(car (epg-key-sub-key-list key))))
keys))))
-(make-obsolete 'epg-start-sign-keys "do not use." "23.1")
(defun epg-sign-keys (context keys &optional local)
"Sign KEYS from the key ring."
+ (declare (obsolete nil "23.1"))
(unwind-protect
(progn
(epg-start-sign-keys context keys local)
(list "Sign keys failed"
(epg-errors-to-string errors))))))
(epg-reset context)))
-(make-obsolete 'epg-sign-keys "do not use." "23.1")
(defun epg-start-generate-key (context parameters)
"Initiate a key generation.
HCoop / bpt / emacs.git / blobdiff