;;; epg.el --- the EasyPG Library -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2000, 2002-2014 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2000, 2002-2016 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG
(defvar epg-debug-buffer nil)
(defvar epg-agent-file nil)
(defvar epg-agent-mtime nil)
-(defvar epg-error-output nil)
;; from gnupg/include/cipher.h
(defconst epg-cipher-algorithm-alist
compress-algorithm
&aux
(program
- (pcase protocol
- (`OpenPGP epg-gpg-program)
- (`CMS epg-gpgsm-program)
- (_ (signal 'epg-error
- (list "unknown protocol" protocol)))))))
+ (let ((configuration (epg-find-configuration protocol)))
+ (unless configuration
+ (signal 'epg-error
+ (list "no usable configuration" protocol)))
+ (alist-get 'program configuration)))))
(:copier nil)
(:predicate nil))
protocol
compress-algorithm
(passphrase-callback (list #'epg-passphrase-callback-function))
progress-callback
+ edit-callback
signers
sig-notations
process
result
operation
pinentry-mode
- (error-output ""))
+ (error-output "")
+ error-buffer)
;; This is not an alias, just so we can mark it as autoloaded.
;;;###autoload
query by itself and Emacs can intercept them."
;; (declare (obsolete setf "25.1"))
(setf (epg-context-passphrase-callback context)
- (if (consp passphrase-callback) ;FIXME: functions can also be consp!
- passphrase-callback
- (list passphrase-callback))))
+ (if (functionp passphrase-callback)
+ (list passphrase-callback)
+ passphrase-callback)))
(defun epg-context-set-progress-callback (context
progress-callback)
current amount done, the total amount to be done, and the
callback data (if any)."
(setf (epg-context-progress-callback context)
- (if (consp progress-callback) ;FIXME: could be a function!
- progress-callback
- (list progress-callback))))
+ (if (functionp progress-callback)
+ (list progress-callback)
+ progress-callback)))
(defun epg-context-set-signers (context signers)
"Set the list of key-id for signing."
(defun epg-errors-to-string (errors)
(mapconcat #'epg-error-to-string errors "; "))
+(declare-function pinentry-start "pinentry" (&optional quiet))
+
(defun epg--start (context args)
"Start `epg-gpg-program' in a subprocess with given ARGS."
(if (and (epg-context-process context)
(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)
(buffer (generate-new-buffer " *epg*"))
+ error-process
process
terminal-name
agent-file
(setq process-environment
(cons (concat "GPG_TTY=" terminal-name)
(cons "TERM=xterm" process-environment))))
+ ;; Automatically start the Emacs Pinentry server if appropriate.
+ (when (and (fboundp 'pinentry-start)
+ ;; Emacs Pinentry is useless if Emacs has no interactive session.
+ (not noninteractive)
+ ;; Prefer pinentry-mode over Emacs Pinentry.
+ (null (epg-context-pinentry-mode context))
+ ;; Check if the allow-emacs-pinentry option is set.
+ (executable-find epg-gpgconf-program)
+ (with-temp-buffer
+ (when (= (call-process epg-gpgconf-program nil t nil
+ "--list-options" "gpg-agent")
+ 0)
+ (goto-char (point-min))
+ (re-search-forward
+ "^allow-emacs-pinentry:\\(?:.*:\\)\\{8\\}1"
+ nil t))))
+ (pinentry-start 'quiet))
+ (setq process-environment
+ (cons (format "INSIDE_EMACS=%s,epg" emacs-version)
+ process-environment))
;; Record modified time of gpg-agent socket to restore the Emacs
;; frame on text terminal in `epg-wait-for-completion'.
;; See
(make-local-variable 'epg-agent-file)
(setq epg-agent-file agent-file)
(make-local-variable 'epg-agent-mtime)
- (setq epg-agent-mtime agent-mtime)
- (make-local-variable 'epg-error-output)
- (setq epg-error-output nil))
+ (setq epg-agent-mtime agent-mtime))
+ (setq error-process
+ (make-pipe-process :name "epg-error"
+ :buffer (generate-new-buffer " *epg-error*")
+ ;; Suppress "XXX finished" line.
+ :sentinel #'ignore
+ :noquery t))
+ (setf (epg-context-error-buffer context) (process-buffer error-process))
(with-file-modes 448
- (setq process (apply #'start-process "epg" buffer
- (epg-context-program context) args)))
- (set-process-filter process #'epg--process-filter)
+ (setq process (make-process :name "epg"
+ :buffer buffer
+ :command (cons (epg-context-program context)
+ args)
+ :connection-type 'pipe
+ :coding '(binary . binary)
+ :filter #'epg--process-filter
+ :stderr error-process
+ :noquery t)))
(setf (epg-context-process context) process)))
(defun epg--process-filter (process input)
(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))))
+ (let ((status (match-string 1))
+ (string (match-string 2))
+ symbol)
(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)))
- ;; Record other lines sent to stderr. This assumes
- ;; that the process-filter receives output only from
- ;; stderr and the FD specified with --status-fd.
- (setq epg-error-output
- (cons (buffer-substring (point)
- (line-end-position))
- epg-error-output)))
+ ;; When editing a key, delegate all interaction
+ ;; to edit-callback.
+ (if (eq (epg-context-operation epg-context) 'edit-key)
+ (funcall (car (epg-context-edit-callback
+ epg-context))
+ epg-context
+ status
+ string
+ (cdr (epg-context-edit-callback
+ epg-context)))
+ ;; Otherwise call epg--status-STATUS function.
+ (setq symbol (intern-soft (concat "epg--status-"
+ status)))
+ (if (and symbol
+ (fboundp symbol))
+ (funcall symbol epg-context string)))
+ (setq epg-last-status (cons status string))))
(forward-line)
(setq epg-read-point (point)))))))))
(epg-context-set-result-for
context 'error
(nreverse (epg-context-result-for context 'error)))
- (with-current-buffer (process-buffer (epg-context-process context))
- (setf (epg-context-error-output context)
- (mapconcat #'identity (nreverse epg-error-output) "\n"))))
+ (setf (epg-context-error-output context)
+ (with-current-buffer (epg-context-error-buffer context)
+ (buffer-string))))
(defun epg-reset (context)
"Reset the CONTEXT."
(if (and (epg-context-process context)
(buffer-live-p (process-buffer (epg-context-process context))))
(kill-buffer (process-buffer (epg-context-process context))))
- (setf (epg-context-process context) nil))
+ (if (buffer-live-p (epg-context-error-buffer context))
+ (kill-buffer (epg-context-error-buffer context)))
+ (setf (epg-context-process context) nil)
+ (setf (epg-context-edit-callback context) nil))
(defun epg-delete-output-file (context)
"Delete the output file of CONTEXT."
(defun epg-list-keys (context &optional name mode)
"Return a list of epg-key objects matched with NAME.
-If MODE is nil or 'public, only public keyring should be searched.
-If MODE is t or 'secret, only secret keyring should be searched.
+If MODE is nil or `public', only public keyring should be searched.
+If MODE is t or `secret', only secret keyring should be searched.
Otherwise, only public keyring should be searched and the key
signatures should be included.
NAME is either a string or a list of strings."
To check the verification results, use `epg-context-result-for' as follows:
-\(epg-context-result-for context 'verify)
+\(epg-context-result-for context \\='verify)
which will return a list of `epg-signature' object."
(unwind-protect
To check the verification results, use `epg-context-result-for' as follows:
-\(epg-context-result-for context 'verify)
+\(epg-context-result-for context \\='verify)
which will return a list of `epg-signature' object."
(let ((coding-system-for-write 'binary)
"Initiate a sign operation on PLAIN.
PLAIN is a data object.
-If optional 3rd argument MODE is t or 'detached, it makes a detached signature.
-If it is nil or 'normal, it makes a normal signature.
+If optional 3rd argument MODE is t or `detached', it makes a detached signature.
+If it is nil or `normal', it makes a normal signature.
Otherwise, it makes a cleartext signature.
If you use this function, you will need to wait for the completion of
(defun epg-sign-file (context plain signature &optional mode)
"Sign a file PLAIN and store the result to a file SIGNATURE.
If SIGNATURE is nil, it returns the result as a string.
-If optional 3rd argument MODE is t or 'detached, it makes a detached signature.
-If it is nil or 'normal, it makes a normal signature.
+If optional 3rd argument MODE is t or `detached', it makes a detached signature.
+If it is nil or `normal', it makes a normal signature.
Otherwise, it makes a cleartext signature."
(unwind-protect
(progn
(defun epg-sign-string (context plain &optional mode)
"Sign a string PLAIN and return the output as string.
-If optional 3rd argument MODE is t or 'detached, it makes a detached signature.
-If it is nil or 'normal, it makes a normal signature.
+If optional 3rd argument MODE is t or `detached', it makes a detached signature.
+If it is nil or `normal', it makes a normal signature.
Otherwise, it makes a cleartext signature."
(let ((input-file
- (unless (or (eq (epg-context-protocol context) 'CMS)
- (condition-case nil
- (progn
- (epg-check-configuration (epg-configuration))
- t)
- (error)))
+ (unless (eq (epg-context-protocol context) 'CMS)
(epg--make-temp-file "epg-input")))
(coding-system-for-write 'binary))
(unwind-protect
If RECIPIENTS is nil, it performs symmetric encryption."
(let ((input-file
(unless (or (not sign)
- (eq (epg-context-protocol context) 'CMS)
- (condition-case nil
- (progn
- (epg-check-configuration (epg-configuration))
- t)
- (error)))
+ (eq (epg-context-protocol context) 'CMS))
(epg--make-temp-file "epg-input")))
(coding-system-for-write 'binary))
(unwind-protect
(defun epg-start-generate-key (context parameters)
"Initiate a key generation.
-PARAMETERS specifies parameters for the key.
+PARAMETERS is a string which specifies parameters of the generated key.
+See Info node `(gnupg) Unattended GPG key generation' in the
+GnuPG manual for the format.
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
(setf (epg-context-operation context) 'generate-key)
(setf (epg-context-result context) nil)
(if (epg-data-file parameters)
- (epg--start context (list "--batch" "--genkey" "--"
+ (epg--start context (list "--batch" "--gen-key" "--"
(epg-data-file parameters)))
- (epg--start context '("--batch" "--genkey"))
+ (epg--start context '("--batch" "--gen-key"))
(if (eq (process-status (epg-context-process context)) 'run)
(process-send-string (epg-context-process context)
(epg-data-string parameters)))
(epg-errors-to-string errors))))))
(epg-reset context)))
+(defun epg-start-edit-key (context key edit-callback handback)
+ "Initiate an edit operation on KEY.
+
+EDIT-CALLBACK is called from process filter and takes 3
+arguments: the context, a status, an argument string, and the
+handback argument.
+
+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
+`epg-reset' to clear a temporary output file.
+If you are unsure, use synchronous version of this function
+`epg-edit-key' instead."
+ (setf (epg-context-operation context) 'edit-key)
+ (setf (epg-context-result context) nil)
+ (setf (epg-context-edit-callback context) (cons edit-callback handback))
+ (epg--start context (list "--edit-key"
+ (epg-sub-key-id
+ (car (epg-key-sub-key-list key))))))
+
+(defun epg-edit-key (context key edit-callback handback)
+ "Edit KEY in the keyring."
+ (unwind-protect
+ (progn
+ (epg-start-edit-key context key edit-callback handback)
+ (epg-wait-for-completion context)
+ (let ((errors (epg-context-result-for context 'error)))
+ (if errors
+ (signal 'epg-error
+ (list "Edit key failed"
+ (epg-errors-to-string errors))))))
+ (epg-reset context)))
+
(defun epg--decode-percent-escape (string)
(let ((index 0))
(while (string-match "%\\(\\(%\\)\\|\\([0-9A-Fa-f][0-9A-Fa-f]\\)\\)"
(if (eq index (string-match "[ \t\n\r]*" string index))
(setq index (match-end 0)))
(if (eq index (string-match
- "\\([0-9]+\\(\\.[0-9]+\\)*\\)\[ \t\n\r]*=[ \t\n\r]*"
+ "\\([0-9]+\\(\\.[0-9]+\\)*\\)[ \t\n\r]*=[ \t\n\r]*"
string index))
(setq type (match-string 1 string)
index (match-end 0))