File emacs-27.1-Xauthority4server.patch of Package emacs

Overview Repositories Revisions Requests Users Attributes Meta

File emacs-27.1-Xauthority4server.patch of Package emacs (Revision 020f7b15c2d748292ed26515733cb367)

Currently displaying revision 020f7b15c2d748292ed26515733cb367 , Show latest

From werner@suse.de
Date: Mon, 08 Mar 2021 13:35:41 +0000
Subject: Allow GNU Emacs server to open X Display

even if the Xauthority file is not the default expected by XCloseDisplay()

---
 etc/emacs.service |    1 +
 lisp/server.el    |   45 +++++++++++++++++++++++++++++++++++++++++++--
 2 files changed, 44 insertions(+), 2 deletions(-)

--- etc/emacs.service
+++ etc/emacs.service	2023-08-01 07:24:44.856332618 +0000
@@ -8,6 +8,7 @@ Documentation=info:emacs man:emacs(1) ht
 
 [Service]
 Type=notify
+Environment=XAUTHORITY=%t/emacs/xauth
 ExecStart=emacs --fg-daemon
 
 # Emacs will exit with status 15 after having received SIGTERM, which
--- lisp/server.el
+++ lisp/server.el	2023-08-01 08:08:52.491668562 +0000
@@ -287,6 +287,11 @@ If nil, no instructions are displayed."
   "The directory in which to place the server socket.
 If local sockets are not supported, this is nil.")
 
+;; Hold the Xauthority if an X Display is used
+(defvar server-xauth-file nil
+  "The Xauthority file to hold the Xauthority cookies.
+If no Xauthority is used, this is nil.")
+
 (define-error 'server-running-external "External server running")
 
 (defun server-clients-with (property value)
@@ -617,6 +622,11 @@ If the key is not valid, signal an error
   (let ((server-dir (if server-use-tcp server-auth-dir server-socket-dir)))
     (expand-file-name server-name server-dir)))
 
+(defsubst server--xauth ()
+  "Return the xauth file name to hold the X Authority."
+  (let ((server-dir (if server-use-tcp server-auth-dir server-socket-dir)))
+    (expand-file-name "xauth" server-dir)))
+
 (defun server-stop (&optional noframe)
   "If this Emacs process has a server communication subprocess, stop it.
 If this actually stopped the server, return non-nil.  If the
@@ -718,7 +728,8 @@ the `server-process' variable."
        (setq leave-dead t)))
       ;; Now any previous server is properly stopped.
     (unless leave-dead
-      (let ((server-file (server--file-name)))
+      (let ((server-file (server--file-name))
+	    (xauth-file (server--xauth)))
 	;; Make sure there is a safe directory in which to place the socket.
 	(server-ensure-safe-dir (file-name-directory server-file))
         (with-file-modes ?\700
@@ -760,6 +771,14 @@ the `server-process' variable."
 	  (unless server-process (error "Could not start server process"))
           (server-log "Started server")
 	  (process-put server-process :server-file server-file)
+	  ;; File to hold X Authority cookies
+	  (unless (file-exists-p xauth-file)
+	    (make-empty-file xauth-file))
+	  (when (file-exists-p xauth-file)
+	    (let ((var (concat "XAUTHORITY=" xauth-file)))
+		(dolist (proc (process-list))
+		  (process-put proc 'env (cons var (process-get proc 'env)))))
+	    (setq server-xauth-file xauth-file))
           (setq server-mode t)
           (push 'server-mode global-minor-modes)
 	  (when server-use-tcp
@@ -896,7 +915,7 @@ This handles splitting the command if it
   (let ((frame
          (server-with-environment
              (process-get proc 'env)
-             '("LANG" "LC_CTYPE" "LC_ALL"
+             '("LANG" "LC_CTYPE" "LC_ALL" "LC_PAPER" "LC_MEASUREMENT"
                ;; For tgetent(3); list according to ncurses(3).
                "BAUDRATE" "COLUMNS" "ESCDELAY" "HOME" "LINES"
                "NCURSES_ASSUMED_COLORS" "NCURSES_NO_PADDING"
@@ -1169,6 +1188,8 @@ The following commands are accepted by t
 		nowait     ; t if emacsclient does not want to wait for us.
 		frame      ; Frame opened for the client (if any).
 		display    ; Open frame on this display.
+		(xauth-file (expand-file-name "~/.Xauthority"))
+		xauth-cmd
 		parent-id  ; Window ID for XEmbed
 		dontkill   ; t if client should not be killed.
 		commands
@@ -1309,6 +1330,16 @@ The following commands are accepted by t
                 ;; -env NAME=VALUE:  An environment variable.
                 ("-env"
                  (let ((var (pop args-left)))
+		   (if (and (stringp var)
+		         (string-match "^\\([^=]+\\)=\\(.*\\)" var))
+			 (if (cond ((string-equal (match-string 1 var) "LANG") t)
+			       ((string-equal (match-string 1 var) "LC_CTYPE") t)
+			       ((string-equal (match-string 1 var) "LC_ALL") t)
+			       ((string-equal (match-string 1 var) "LC_PAPER") t)
+			       ((string-equal (match-string 1 var) "LC_MEASUREMENT") t)
+			       ((string-equal (match-string 1 var) "DISPLAY") t)
+			       ((string-equal (match-string 1 var) "XAUTHORITY") (setq xauth-file (match-string 2 var))))
+			     (setenv (match-string 1 var) (match-string 2 var) t)))
                    ;; XXX Variables should be encoded as in getenv/setenv.
                    (process-put proc 'env
                                 (cons var (process-get proc 'env)))))
@@ -1324,6 +1355,16 @@ The following commands are accepted by t
                 ;; Unknown command.
                 (arg (error "Unknown command: %s" arg))))
 
+	    (if (and display server-xauth-file)
+		(progn
+		    (if (not xauth-file)
+			(setq xauth-file (expand-file-name "~/.Xauthority")))
+		    (if (and (file-exists-p xauth-file) (not (file-equal-p xauth-file server-xauth-file)))
+			(progn
+			    (setq xauth-cmd (concat "xauth -f " xauth-file " extract - " display
+				"| xauth -f " server-xauth-file " merge -"))
+			    (shell-command xauth-cmd)))))
+
 	    ;; If both -no-wait and -tty are given with file or sexp
 	    ;; arguments, use an existing frame.
 	    (and nowait

Places

File emacs-27.1-Xauthority4server.patch of Package emacs (Revision 020f7b15c2d748292ed26515733cb367)

Places