Mercurial > emacs
changeset 73628:97c917d6101a
(server-auth-key): Remove. Replace by a process-property.
(server-start): Don't remove the file of the previous process, but
instead clear out the place for the new file.
(server-start): Set the :auth-key property.
(server-process-filter): Use the :auth-key property.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Thu, 02 Nov 2006 23:46:14 +0000 |
| parents | e7c14a8e6688 |
| children | df25a33a90b0 |
| files | lisp/ChangeLog lisp/server.el |
| diffstat | 2 files changed, 59 insertions(+), 52 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Thu Nov 02 23:10:57 2006 +0000 +++ b/lisp/ChangeLog Thu Nov 02 23:46:14 2006 +0000 @@ -1,3 +1,11 @@ +2006-11-02 Stefan Monnier <monnier@iro.umontreal.ca> + + * server.el (server-auth-key): Remove. Replace by a process-property. + (server-start): Don't remove the file of the previous process, but + instead clear out the place for the new file. + (server-start): Set the :auth-key property. + (server-process-filter): Use the :auth-key property. + 2006-11-02 Carsten Dominik <dominik@science.uva.nl> * textmodes/org.el (org-mode-map): No longer copy
--- a/lisp/server.el Thu Nov 02 23:10:57 2006 +0000 +++ b/lisp/server.el Thu Nov 02 23:46:14 2006 +0000 @@ -112,10 +112,6 @@ :version "22.1") (put 'server-auth-dir 'risky-local-variable t) -(defvar server-auth-key nil - "The current server authentication key.") -(put 'server-auth-key 'risky-local-variable t) - (defcustom server-visit-hook nil "*Hook run when visiting a file for the Emacs server." :group 'server @@ -228,6 +224,12 @@ (when (and (eq (process-status proc) 'open) (process-query-on-exit-flag proc)) (set-process-query-on-exit-flag proc nil)) + ;; Delete the associated connection file, if applicable. + ;; This is actually problematic: the file may have been overwritten by + ;; another Emacs server in the mean time, so it's not ours any more. + ;; (and (process-contact proc :server) + ;; (eq (process-status proc) 'closed) + ;; (ignore-errors (delete-file (process-get proc :server-file)))) (server-log (format "Status changed to %s" (process-status proc)) proc)) (defun server-select-display (display) @@ -307,61 +309,58 @@ (interactive "P") (when server-process ;; kill it dead! - (ignore-errors (delete-process server-process)) - (ignore-errors - ;; Delete the socket or authentication files made by previous - ;; server invocations. - (if (eq (process-contact server-process :family) 'local) - (delete-file (expand-file-name server-name server-socket-dir)) - (setq server-auth-key nil) - (delete-file (expand-file-name server-name server-auth-dir))))) + (ignore-errors (delete-process server-process))) ;; If this Emacs already had a server, clear out associated status. (while server-clients (let ((buffer (nth 1 (car server-clients)))) (server-buffer-done buffer))) ;; Now any previous server is properly stopped. (unless leave-dead - ;; Make sure there is a safe directory in which to place the socket. - (server-ensure-safe-dir - (if server-use-tcp server-auth-dir server-socket-dir)) - (when server-process - (server-log (message "Restarting server"))) - (letf (((default-file-modes) ?\700)) - (setq server-process - (apply #'make-network-process - :name server-name - :server t - :noquery t - :sentinel 'server-sentinel - :filter 'server-process-filter - ;; We must receive file names without being decoded. - ;; Those are decoded by server-process-filter according - ;; to file-name-coding-system. - :coding 'raw-text - ;; The rest of the args depends on the kind of socket used. - (if server-use-tcp - (list :family nil - :service t - :host (or server-host 'local) - :plist '(:authenticated nil)) - (list :family 'local - :service (expand-file-name server-name server-socket-dir) - :plist '(:authenticated t))))) + (let* ((server-dir (if server-use-tcp server-auth-dir server-socket-dir)) + (server-file (expand-file-name server-name server-dir))) + ;; Make sure there is a safe directory in which to place the socket. + (server-ensure-safe-dir server-dir) + ;; Remove any leftover socket or authentication file. + (ignore-errors (delete-file server-file)) + (when server-process + (server-log (message "Restarting server"))) + (letf (((default-file-modes) ?\700)) + (setq server-process + (apply #'make-network-process + :name server-name + :server t + :noquery t + :sentinel 'server-sentinel + :filter 'server-process-filter + ;; We must receive file names without being decoded. + ;; Those are decoded by server-process-filter according + ;; to file-name-coding-system. + :coding 'raw-text + ;; The rest of the args depends on the kind of socket used. + (if server-use-tcp + (list :family nil + :service t + :host (or server-host 'local) + :plist '(:authenticated nil)) + (list :family 'local + :service server-file + :plist '(:authenticated t))))) (unless server-process (error "Could not start server process")) (when server-use-tcp - (setq server-auth-key - (loop - ;; The auth key is a 64-byte string of random chars in the - ;; range `!'..`~'. - for i below 64 - collect (+ 33 (random 94)) into auth - finally return (concat auth))) - (with-temp-file (expand-file-name server-name server-auth-dir) - (set-buffer-multibyte nil) - (setq buffer-file-coding-system 'no-conversion) - (insert (format-network-address - (process-contact server-process :local)) - "\n" server-auth-key)))))) + (let ((auth-key + (loop + ;; The auth key is a 64-byte string of random chars in the + ;; range `!'..`~'. + for i below 64 + collect (+ 33 (random 94)) into auth + finally return (concat auth)))) + (process-put server-process :auth-key auth-key) + (with-temp-file server-file + (set-buffer-multibyte nil) + (setq buffer-file-coding-system 'no-conversion) + (insert (format-network-address + (process-contact server-process :local)) + "\n" auth-key)))))))) ;;;###autoload (define-minor-mode server-mode @@ -382,7 +381,7 @@ ;; First things first: let's check the authentication (unless (process-get proc :authenticated) (if (and (string-match "-auth \\(.*?\\)\n" string) - (string= (match-string 1 string) server-auth-key)) + (equal (match-string 1 string) (process-get proc :auth-key))) (progn (setq string (substring string (match-end 0))) (process-put proc :authenticated t)