[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master b407c52: Remove pinentry.el
|
From: |
Daiki Ueno |
|
Subject: |
[Emacs-diffs] master b407c52: Remove pinentry.el |
|
Date: |
Fri, 24 Nov 2017 10:41:48 -0500 (EST) |
branch: master
commit b407c521f24b07b76eee0cd06d471e629cef18e8
Author: Daiki Ueno <address@hidden>
Commit: Daiki Ueno <address@hidden>
Remove pinentry.el
* lisp/epg.el (epg--start): Remove the use of pinentry.el.
* lisp/net/pinentry.el: Remove (bug#27445).
---
lisp/epg.el | 19 ---
lisp/net/pinentry.el | 460 ---------------------------------------------------
2 files changed, 479 deletions(-)
diff --git a/lisp/epg.el b/lisp/epg.el
index fee6ad7..903cbd6 100644
--- a/lisp/epg.el
+++ b/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))
diff --git a/lisp/net/pinentry.el b/lisp/net/pinentry.el
deleted file mode 100644
index f8d81fd..0000000
--- a/lisp/net/pinentry.el
+++ /dev/null
@@ -1,460 +0,0 @@
-;;; pinentry.el --- GnuPG Pinentry server implementation -*- lexical-binding:
t -*-
-
-;; Copyright (C) 2015-2017 Free Software Foundation, Inc.
-
-;; Author: Daiki Ueno <address@hidden>
-;; 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
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master b407c52: Remove pinentry.el,
Daiki Ueno <=