mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-04 06:31:13 -08:00
Remove pinentry.el
* lisp/epg.el (epg--start): Remove the use of pinentry.el. * lisp/net/pinentry.el: Remove (bug#27445).
This commit is contained in:
Daiki Ueno
parent
b3f4a3a5ae
commit
8a73b7003e
2 changed files with 0 additions and 479 deletions
19
lisp/epg.el
19
lisp/epg.el
|
|
@ -551,8 +551,6 @@ callback data (if any)."
|
|||
(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)
|
||||
|
|
@ -604,23 +602,6 @@ callback data (if any)."
|
|||
(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))
|
||||
|
|
|
|||
|
|
@ -1,460 +0,0 @@
|
|||
;;; pinentry.el --- GnuPG Pinentry server implementation -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2015-2017 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Daiki Ueno <ueno@gnu.org>
|
||||
;; Version: 0.1
|
||||
;; Keywords: 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 3 of the License, 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. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This package allows GnuPG passphrase to be prompted through the
|
||||
;; minibuffer instead of graphical dialog.
|
||||
;;
|
||||
;; To use, add "allow-emacs-pinentry" to "~/.gnupg/gpg-agent.conf",
|
||||
;; reload the configuration with "gpgconf --reload gpg-agent", and
|
||||
;; start the server with M-x pinentry-start.
|
||||
;;
|
||||
;; The actual communication path between the relevant components is
|
||||
;; as follows:
|
||||
;;
|
||||
;; gpg --> gpg-agent --> pinentry --> Emacs
|
||||
;;
|
||||
;; where pinentry and Emacs communicate through a Unix domain socket
|
||||
;; created at:
|
||||
;;
|
||||
;; ${TMPDIR-/tmp}/emacs$(id -u)/pinentry
|
||||
;;
|
||||
;; under the same directory which server.el uses. The protocol is a
|
||||
;; subset of the Pinentry Assuan protocol described in (info
|
||||
;; "(pinentry) Protocol").
|
||||
;;
|
||||
;; NOTE: As of August 2015, this feature requires newer versions of
|
||||
;; GnuPG (2.1.5+) and Pinentry (0.9.5+).
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
|
||||
(defgroup pinentry nil
|
||||
"The Pinentry server"
|
||||
:version "25.1"
|
||||
:group 'external)
|
||||
|
||||
(defcustom pinentry-popup-prompt-window t
|
||||
"If non-nil, display multiline prompt in another window."
|
||||
:type 'boolean
|
||||
:group 'pinentry)
|
||||
|
||||
(defcustom pinentry-prompt-window-height 5
|
||||
"Number of lines used to display multiline prompt."
|
||||
:type 'integer
|
||||
:group 'pinentry)
|
||||
|
||||
(defvar pinentry-debug nil)
|
||||
(defvar pinentry-debug-buffer nil)
|
||||
(defvar pinentry--server-process nil)
|
||||
(defvar pinentry--connection-process-list nil)
|
||||
|
||||
(defvar pinentry--labels nil)
|
||||
(put 'pinentry-read-point 'permanent-local t)
|
||||
(defvar pinentry--read-point nil)
|
||||
(put 'pinentry--read-point 'permanent-local t)
|
||||
|
||||
(defvar pinentry--prompt-buffer nil)
|
||||
|
||||
;; We use the same location as `server-socket-dir', when local sockets
|
||||
;; are supported.
|
||||
(defvar pinentry--socket-dir
|
||||
(format "%s/emacs%d" (or (getenv "TMPDIR") "/tmp") (user-uid))
|
||||
"The directory in which to place the server socket.
|
||||
If local sockets are not supported, this is nil.")
|
||||
|
||||
(defconst pinentry--set-label-commands
|
||||
'("SETPROMPT" "SETTITLE" "SETDESC"
|
||||
"SETREPEAT" "SETREPEATERROR"
|
||||
"SETOK" "SETCANCEL" "SETNOTOK"))
|
||||
|
||||
;; These error codes are defined in libgpg-error/src/err-codes.h.in.
|
||||
(defmacro pinentry--error-code (code)
|
||||
(logior (lsh 5 24) code))
|
||||
(defconst pinentry--error-not-implemented
|
||||
(cons (pinentry--error-code 69) "not implemented"))
|
||||
(defconst pinentry--error-cancelled
|
||||
(cons (pinentry--error-code 99) "cancelled"))
|
||||
(defconst pinentry--error-not-confirmed
|
||||
(cons (pinentry--error-code 114) "not confirmed"))
|
||||
|
||||
(autoload 'server-ensure-safe-dir "server")
|
||||
|
||||
(defvar pinentry-prompt-mode-map
|
||||
(let ((keymap (make-sparse-keymap)))
|
||||
(define-key keymap "q" 'quit-window)
|
||||
keymap))
|
||||
|
||||
(define-derived-mode pinentry-prompt-mode special-mode "Pinentry"
|
||||
"Major mode for `pinentry--prompt-buffer'."
|
||||
(buffer-disable-undo)
|
||||
(setq truncate-lines t
|
||||
buffer-read-only t))
|
||||
|
||||
(defun pinentry--prompt (labels query-function &rest query-args)
|
||||
(let ((desc (cdr (assq 'desc labels)))
|
||||
(error (cdr (assq 'error labels)))
|
||||
(prompt (cdr (assq 'prompt labels))))
|
||||
(when (string-match "[ \n]*\\'" prompt)
|
||||
(setq prompt (concat
|
||||
(substring
|
||||
prompt 0 (match-beginning 0)) " ")))
|
||||
(when error
|
||||
(setq desc (concat "Error: " (propertize error 'face 'error)
|
||||
"\n" desc)))
|
||||
(if (and desc pinentry-popup-prompt-window)
|
||||
(save-window-excursion
|
||||
(delete-other-windows)
|
||||
(unless (and pinentry--prompt-buffer
|
||||
(buffer-live-p pinentry--prompt-buffer))
|
||||
(setq pinentry--prompt-buffer (generate-new-buffer "*Pinentry*")))
|
||||
(if (get-buffer-window pinentry--prompt-buffer)
|
||||
(delete-window (get-buffer-window pinentry--prompt-buffer)))
|
||||
(with-current-buffer pinentry--prompt-buffer
|
||||
(let ((inhibit-read-only t)
|
||||
buffer-read-only)
|
||||
(erase-buffer)
|
||||
(insert desc))
|
||||
(pinentry-prompt-mode)
|
||||
(goto-char (point-min)))
|
||||
(if (> (window-height)
|
||||
pinentry-prompt-window-height)
|
||||
(set-window-buffer (split-window nil
|
||||
(- (window-height)
|
||||
pinentry-prompt-window-height))
|
||||
pinentry--prompt-buffer)
|
||||
(pop-to-buffer pinentry--prompt-buffer)
|
||||
(if (> (window-height) pinentry-prompt-window-height)
|
||||
(shrink-window (- (window-height)
|
||||
pinentry-prompt-window-height))))
|
||||
(prog1 (apply query-function prompt query-args)
|
||||
(quit-window)))
|
||||
(apply query-function (concat desc "\n" prompt) query-args))))
|
||||
|
||||
;;;###autoload
|
||||
(defun pinentry-start (&optional quiet)
|
||||
"Start a Pinentry service.
|
||||
|
||||
Once the environment is properly set, subsequent invocations of
|
||||
the gpg command will interact with Emacs for passphrase input.
|
||||
|
||||
If the optional QUIET argument is non-nil, messages at startup
|
||||
will not be shown."
|
||||
(interactive)
|
||||
(unless (featurep 'make-network-process '(:family local))
|
||||
(error "local sockets are not supported"))
|
||||
(if (process-live-p pinentry--server-process)
|
||||
(unless quiet
|
||||
(message "Pinentry service is already running"))
|
||||
(let* ((server-file (expand-file-name "pinentry" pinentry--socket-dir)))
|
||||
(server-ensure-safe-dir pinentry--socket-dir)
|
||||
;; Delete the socket files made by previous server invocations.
|
||||
(ignore-errors
|
||||
(let (delete-by-moving-to-trash)
|
||||
(delete-file server-file)))
|
||||
(cl-letf (((default-file-modes) ?\700))
|
||||
(setq pinentry--server-process
|
||||
(make-network-process
|
||||
:name "pinentry"
|
||||
:server t
|
||||
:noquery t
|
||||
:sentinel #'pinentry--process-sentinel
|
||||
:filter #'pinentry--process-filter
|
||||
:coding 'no-conversion
|
||||
:family 'local
|
||||
:service server-file))
|
||||
(process-put pinentry--server-process :server-file server-file)))))
|
||||
|
||||
(defun pinentry-stop ()
|
||||
"Stop a Pinentry service."
|
||||
(interactive)
|
||||
(when (process-live-p pinentry--server-process)
|
||||
(delete-process pinentry--server-process))
|
||||
(setq pinentry--server-process nil)
|
||||
(dolist (process pinentry--connection-process-list)
|
||||
(when (buffer-live-p (process-buffer process))
|
||||
(kill-buffer (process-buffer process))))
|
||||
(setq pinentry--connection-process-list nil))
|
||||
|
||||
(defun pinentry--labels-to-shortcuts (labels)
|
||||
"Convert strings in LABEL by stripping mnemonics."
|
||||
(mapcar (lambda (label)
|
||||
(when label
|
||||
(let (c)
|
||||
(if (string-match "\\(?:\\`\\|[^_]\\)_\\([[:alnum:]]\\)" label)
|
||||
(let ((key (match-string 1 label)))
|
||||
(setq c (downcase (aref key 0)))
|
||||
(setq label (replace-match
|
||||
(propertize key 'face 'underline)
|
||||
t t label)))
|
||||
(setq c (if (= (length label) 0)
|
||||
??
|
||||
(downcase (aref label 0)))))
|
||||
;; Double underscores mean a single underscore.
|
||||
(when (string-match "__" label)
|
||||
(setq label (replace-match "_" t t label)))
|
||||
(cons c label))))
|
||||
labels))
|
||||
|
||||
(defun pinentry--escape-string (string)
|
||||
"Escape STRING in the Assuan percent escape."
|
||||
(let ((length (length string))
|
||||
(index 0)
|
||||
(count 0))
|
||||
(while (< index length)
|
||||
(if (memq (aref string index) '(?\n ?\r ?%))
|
||||
(setq count (1+ count)))
|
||||
(setq index (1+ index)))
|
||||
(setq index 0)
|
||||
(let ((result (make-string (+ length (* count 2)) ?\0))
|
||||
(result-index 0)
|
||||
c)
|
||||
(while (< index length)
|
||||
(setq c (aref string index))
|
||||
(if (memq c '(?\n ?\r ?%))
|
||||
(let ((hex (format "%02X" c)))
|
||||
(aset result result-index ?%)
|
||||
(setq result-index (1+ result-index))
|
||||
(aset result result-index (aref hex 0))
|
||||
(setq result-index (1+ result-index))
|
||||
(aset result result-index (aref hex 1))
|
||||
(setq result-index (1+ result-index)))
|
||||
(aset result result-index c)
|
||||
(setq result-index (1+ result-index)))
|
||||
(setq index (1+ index)))
|
||||
result)))
|
||||
|
||||
(defun pinentry--unescape-string (string)
|
||||
"Unescape STRING in the Assuan percent escape."
|
||||
(let ((length (length string))
|
||||
(index 0))
|
||||
(let ((result (make-string length ?\0))
|
||||
(result-index 0)
|
||||
c)
|
||||
(while (< index length)
|
||||
(setq c (aref string index))
|
||||
(if (and (eq c '?%) (< (+ index 2) length))
|
||||
(progn
|
||||
(aset result result-index
|
||||
(string-to-number (substring string
|
||||
(1+ index)
|
||||
(+ index 3))
|
||||
16))
|
||||
(setq result-index (1+ result-index))
|
||||
(setq index (+ index 2)))
|
||||
(aset result result-index c)
|
||||
(setq result-index (1+ result-index)))
|
||||
(setq index (1+ index)))
|
||||
(substring result 0 result-index))))
|
||||
|
||||
(defun pinentry--send-data (process escaped)
|
||||
"Send a string ESCAPED to a process PROCESS.
|
||||
ESCAPED will be split if it exceeds the line length limit of the
|
||||
Assuan protocol."
|
||||
(let ((length (length escaped))
|
||||
(index 0))
|
||||
(if (= length 0)
|
||||
(process-send-string process "D \n")
|
||||
(while (< index length)
|
||||
;; 997 = ASSUAN_LINELENGTH (= 1000) - strlen ("D \n")
|
||||
(let* ((sub-length (min (- length index) 997))
|
||||
(sub (substring escaped index (+ index sub-length))))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(process-send-string process "D ")
|
||||
(process-send-string process sub)
|
||||
(process-send-string process "\n"))
|
||||
(clear-string sub))
|
||||
(setq index (+ index sub-length)))))))
|
||||
|
||||
(defun pinentry--send-error (process error)
|
||||
(process-send-string process (format "ERR %d %s\n" (car error) (cdr error))))
|
||||
|
||||
(defun pinentry--process-filter (process input)
|
||||
(unless (buffer-live-p (process-buffer process))
|
||||
(let ((buffer (generate-new-buffer " *pinentry*")))
|
||||
(set-process-buffer process buffer)
|
||||
(with-current-buffer buffer
|
||||
(if (fboundp 'set-buffer-multibyte)
|
||||
(set-buffer-multibyte nil))
|
||||
(make-local-variable 'pinentry--read-point)
|
||||
(setq pinentry--read-point (point-min))
|
||||
(make-local-variable 'pinentry--labels))))
|
||||
(with-current-buffer (process-buffer process)
|
||||
(when pinentry-debug
|
||||
(with-current-buffer
|
||||
(or pinentry-debug-buffer
|
||||
(setq pinentry-debug-buffer (generate-new-buffer
|
||||
" *pinentry-debug*")))
|
||||
(goto-char (point-max))
|
||||
(insert input)))
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(insert input)
|
||||
(goto-char pinentry--read-point)
|
||||
(beginning-of-line)
|
||||
(while (looking-at ".*\n") ;the input line finished
|
||||
(if (looking-at "\\([A-Z_]+\\) ?\\(.*\\)")
|
||||
(let ((command (match-string 1))
|
||||
(string (pinentry--unescape-string (match-string 2))))
|
||||
(pcase command
|
||||
((and set (guard (member set pinentry--set-label-commands)))
|
||||
(when (> (length string) 0)
|
||||
(let* ((symbol (intern (downcase (substring set 3))))
|
||||
(entry (assq symbol pinentry--labels))
|
||||
(label (decode-coding-string string 'utf-8)))
|
||||
(if entry
|
||||
(setcdr entry label)
|
||||
(push (cons symbol label) pinentry--labels))))
|
||||
(ignore-errors
|
||||
(process-send-string process "OK\n")))
|
||||
("NOP"
|
||||
(ignore-errors
|
||||
(process-send-string process "OK\n")))
|
||||
("GETPIN"
|
||||
(let ((confirm (not (null (assq 'repeat pinentry--labels))))
|
||||
passphrase escaped-passphrase encoded-passphrase)
|
||||
(unwind-protect
|
||||
(condition-case err
|
||||
(progn
|
||||
(setq passphrase
|
||||
(pinentry--prompt
|
||||
pinentry--labels
|
||||
#'read-passwd confirm))
|
||||
(setq escaped-passphrase
|
||||
(pinentry--escape-string
|
||||
passphrase))
|
||||
(setq encoded-passphrase (encode-coding-string
|
||||
escaped-passphrase
|
||||
'utf-8))
|
||||
(ignore-errors
|
||||
(pinentry--send-data
|
||||
process encoded-passphrase)
|
||||
(process-send-string process "OK\n")))
|
||||
(error
|
||||
(message "GETPIN error %S" err)
|
||||
(ignore-errors
|
||||
(pinentry--send-error
|
||||
process
|
||||
pinentry--error-cancelled))))
|
||||
(if passphrase
|
||||
(clear-string passphrase))
|
||||
(if escaped-passphrase
|
||||
(clear-string escaped-passphrase))
|
||||
(if encoded-passphrase
|
||||
(clear-string encoded-passphrase))))
|
||||
(setq pinentry--labels nil))
|
||||
("CONFIRM"
|
||||
(let ((prompt
|
||||
(or (cdr (assq 'prompt pinentry--labels))
|
||||
"Confirm? "))
|
||||
(buttons
|
||||
(delq nil
|
||||
(pinentry--labels-to-shortcuts
|
||||
(list (cdr (assq 'ok pinentry--labels))
|
||||
(cdr (assq 'notok pinentry--labels))
|
||||
(cdr (assq 'cancel pinentry--labels))))))
|
||||
entry)
|
||||
(if buttons
|
||||
(progn
|
||||
(setq prompt
|
||||
(concat prompt " ("
|
||||
(mapconcat #'cdr buttons
|
||||
", ")
|
||||
") "))
|
||||
(if (setq entry (assq 'prompt pinentry--labels))
|
||||
(setcdr entry prompt)
|
||||
(setq pinentry--labels (cons (cons 'prompt prompt)
|
||||
pinentry--labels)))
|
||||
(condition-case nil
|
||||
(let ((result (pinentry--prompt pinentry--labels
|
||||
#'read-char)))
|
||||
(if (eq result (caar buttons))
|
||||
(ignore-errors
|
||||
(process-send-string process "OK\n"))
|
||||
(if (eq result (car (nth 1 buttons)))
|
||||
(ignore-errors
|
||||
(pinentry--send-error
|
||||
process
|
||||
pinentry--error-not-confirmed))
|
||||
(ignore-errors
|
||||
(pinentry--send-error
|
||||
process
|
||||
pinentry--error-cancelled)))))
|
||||
(error
|
||||
(ignore-errors
|
||||
(pinentry--send-error
|
||||
process
|
||||
pinentry--error-cancelled)))))
|
||||
(if (setq entry (assq 'prompt pinentry--labels))
|
||||
(setcdr entry prompt)
|
||||
(setq pinentry--labels (cons (cons 'prompt prompt)
|
||||
pinentry--labels)))
|
||||
(if (condition-case nil
|
||||
(pinentry--prompt pinentry--labels #'y-or-n-p)
|
||||
(quit))
|
||||
(ignore-errors
|
||||
(process-send-string process "OK\n"))
|
||||
(ignore-errors
|
||||
(pinentry--send-error
|
||||
process
|
||||
pinentry--error-not-confirmed))))
|
||||
(setq pinentry--labels nil)))
|
||||
(_ (ignore-errors
|
||||
(pinentry--send-error
|
||||
process
|
||||
pinentry--error-not-implemented))))
|
||||
(forward-line)
|
||||
(setq pinentry--read-point (point))))))))
|
||||
|
||||
(defun pinentry--process-sentinel (process _status)
|
||||
"The process sentinel for Emacs server connections."
|
||||
;; If this is a new client process, set the query-on-exit flag to nil
|
||||
;; for this process (it isn't inherited from the server process).
|
||||
(when (and (eq (process-status process) 'open)
|
||||
(process-query-on-exit-flag process))
|
||||
(push process pinentry--connection-process-list)
|
||||
(set-process-query-on-exit-flag process nil)
|
||||
(ignore-errors
|
||||
(process-send-string process "OK Your orders please\n")))
|
||||
;; Kill the process buffer of the connection process.
|
||||
(when (and (not (process-contact process :server))
|
||||
(eq (process-status process) 'closed))
|
||||
(when (buffer-live-p (process-buffer process))
|
||||
(kill-buffer (process-buffer process)))
|
||||
(setq pinentry--connection-process-list
|
||||
(delq process pinentry--connection-process-list)))
|
||||
;; Delete the associated connection file, if applicable.
|
||||
;; Although there's no 100% guarantee that the file is owned by the
|
||||
;; running Emacs instance, server-start uses server-running-p to check
|
||||
;; for possible servers before doing anything, so it *should* be ours.
|
||||
(and (process-contact process :server)
|
||||
(eq (process-status process) 'closed)
|
||||
(ignore-errors
|
||||
(delete-file (process-get process :server-file)))))
|
||||
|
||||
(provide 'pinentry)
|
||||
|
||||
;;; pinentry.el ends here
|
||||
Loading…
Add table
Add a link
Reference in a new issue