procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Change the default socket location for pinentry

Browse source 
* lisp/net/pinentry.el: Require 'cl-lib for `cl-letf'.
(pinentry--socket-dir): Change the default from /tmp/emacsXXX to
~/.emacs.d/pinentry.
(pinentry-start): Change the file modes of the socket file to 0700.
This is just for extra safety since the parent directory is already
protected with `server-ensure-safe-dir'.
This commit is contained in:
Daiki Ueno 2016-02-22 06:06:50 +09:00
parent 5f8965839d
commit e34fbdee8a
1 changed files with 20 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

41
lisp/net/pinentry.el
View file

@ -26,6 +26,9 @@
;; This package allows GnuPG passphrase to be prompted through the ;; This package allows GnuPG passphrase to be prompted through the
;; minibuffer instead of graphical dialog. ;; minibuffer instead of graphical dialog.
;; ;;
;; This feature requires GnuPG 2.1.5 or later and Pinentry 0.9.5 or
;; later, with the Emacs support compiled in.
;;
;; To use, add "allow-emacs-pinentry" to "~/.gnupg/gpg-agent.conf", ;; To use, add "allow-emacs-pinentry" to "~/.gnupg/gpg-agent.conf",
;; reload the configuration with "gpgconf --reload gpg-agent", and ;; reload the configuration with "gpgconf --reload gpg-agent", and
;; start the server with M-x pinentry-start. ;; start the server with M-x pinentry-start.
@ -38,17 +41,15 @@
;; where pinentry and Emacs communicate through a Unix domain socket ;; where pinentry and Emacs communicate through a Unix domain socket
;; created at: ;; created at:
;; ;;
;; ${TMPDIR-/tmp}/emacs$(id -u)/pinentry ;; ~/.emacs.d/pinentry/pinentry
;; ;;
;; under the same directory which server.el uses. The protocol is a ;; The protocol is a subset of the Pinentry Assuan protocol described
;; subset of the Pinentry Assuan protocol described in (info ;; in (info "(pinentry) Protocol").
;; "(pinentry) Protocol").
;;
;; NOTE: As of August 2015, this feature requires newer versions of
;; GnuPG (2.1.5+) and Pinentry (0.9.5+).
;;; Code: ;;; Code:
(eval-when-compile (require 'cl-lib))
(defgroup pinentry nil (defgroup pinentry nil
"The Pinentry server" "The Pinentry server"
:version "25.1" :version "25.1"
@ -76,10 +77,7 @@
(defvar pinentry--prompt-buffer nil) (defvar pinentry--prompt-buffer nil)
;; We use the same location as `server-socket-dir', when local sockets (defvar pinentry--socket-dir (locate-user-emacs-file "pinentry")
;; 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. "The directory in which to place the server socket.
If local sockets are not supported, this is nil.") If local sockets are not supported, this is nil.")
@ -172,16 +170,17 @@ will not be shown."
(ignore-errors (ignore-errors
(let (delete-by-moving-to-trash) (let (delete-by-moving-to-trash)
(delete-file server-file))) (delete-file server-file)))
(setq pinentry--server-process (cl-letf (((default-file-modes) ?\700))
(make-network-process (setq pinentry--server-process
:name "pinentry" (make-network-process
:server t :name "pinentry"
:noquery t :server t
:sentinel #'pinentry--process-sentinel :noquery t
:filter #'pinentry--process-filter :sentinel #'pinentry--process-sentinel
:coding 'no-conversion :filter #'pinentry--process-filter
:family 'local :coding 'no-conversion
:service server-file)) :family 'local
:service server-file)))
(process-put pinentry--server-process :server-file server-file)))) (process-put pinentry--server-process :server-file server-file))))
(defun pinentry-stop () (defun pinentry-stop ()