From a9298135d89f27d4dba9c3e7ca5a7f91839ad944 Mon Sep 17 00:00:00 2001 From: Karoly Lorentey Date: Fri, 20 Feb 2004 01:22:10 +0000 Subject: [PATCH] Verify the version of Emacsclient. lib-src/emacsclient.c (main): Send the version number of emacsclient to the Emacs process, and exit with error if Emacs does not accept it. lisp/server.el (server-with-errors-reported): Removed. (server-process-filter): Cleaned up error handling. Compare the version of emacsclient with emacs-version; signal an error if they do not match. git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-84 --- lib-src/emacsclient.c | 18 ++- lisp/server.el | 262 ++++++++++++++++++++++-------------------- 2 files changed, 154 insertions(+), 126 deletions(-) diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 90224fe51e..3bb2b70ba6 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -562,6 +562,9 @@ To start the server in Emacs, type \"M-x server-start\".\n", fail (); } + /* First of all, send our version number for verification. */ + fprintf (out, "-version %s ", VERSION); + if (nowait) fprintf (out, "-nowait "); @@ -650,7 +653,20 @@ To start the server in Emacs, type \"M-x server-start\".\n", /* Now, wait for an answer and print any messages. */ while ((str = fgets (string, BUFSIZ, in))) { - if (strprefix ("-emacs-pid ", str)) + if (strprefix ("-good-version ", str)) + { + /* OK, we got the green light. */ + } + else if (strprefix ("-bad-version ", str)) + { + if (str[strlen (str) - 1] == '\n') + str[strlen (str) - 1] = 0; + + fprintf (stderr, "%s: Version mismatch: Emacs is %s, but we are %s\n", + argv[0], str + strlen ("-bad-version "), VERSION); + fail (); + } + else if (strprefix ("-emacs-pid ", str)) { emacs_pid = strtol (string + strlen ("-emacs-pid"), NULL, 10); } diff --git a/lisp/server.el b/lisp/server.el index 82f4ec2660..a1619471e5 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -349,17 +349,6 @@ Server mode runs a process that accepts commands from the ;; nothing if there is one (for multiple Emacs sessions)? (server-start (not server-mode))) -(defmacro server-with-errors-reported (&rest forms) - "Evaluate FORMS; if an error occurs, report it to the client -and return nil. Otherwise, return the result of the last form. -For use in server-process-filter only." - `(condition-case err - (progn ,@forms) - (error (ignore-errors - (process-send-string - proc (concat "-error " (error-message-string err))) - (setq request ""))))) - (defun server-process-filter (proc string) "Process a request from the server to edit some files. PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." @@ -368,121 +357,144 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." (when prev (setq string (concat prev string)) (process-put proc 'previous-string nil))) - ;; If the input is multiple lines, - ;; process each line individually. - (while (string-match "\n" string) - (let ((request (substring string 0 (match-beginning 0))) - (coding-system (and default-enable-multibyte-characters - (or file-name-coding-system - default-file-name-coding-system))) - client nowait eval newframe display - registered ; t if the client is already added to server-clients. - (files nil) - (lineno 1) - (columnno 0)) - ;; Remove this line from STRING. - (setq string (substring string (match-end 0))) - (setq client (cons proc nil)) - (while (string-match "[^ ]* " request) - (let ((arg (substring request (match-beginning 0) (1- (match-end 0))))) - (setq request (substring request (match-end 0))) - (cond - ((equal "-nowait" arg) (setq nowait t)) - ((equal "-eval" arg) (setq eval t)) - - ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request)) - (setq display (match-string 1 request) - request (substring request (match-end 0)))) - - ;; Open a new X frame. - ((equal "-window-system" arg) - (server-with-errors-reported - (let ((frame (make-frame-on-display - (or display - (frame-parameter nil 'display) - (getenv "DISPLAY") - (error "Please specify display"))))) - (push (list proc frame) server-frames) - (select-frame frame) - ;; This makes sure that `emacsclient -w -e '(delete-frame)'' works right. - (push client server-clients) - (setq registered t - newframe t)))) - - ;; Open a new tty frame at the client. ARG is the name of the pseudo tty. - ((and (equal "-tty" arg) (string-match "\\([^ ]*\\) \\([^ ]*\\) " request)) - (let ((tty (server-unquote-arg (match-string 1 request))) - (type (server-unquote-arg (match-string 2 request)))) + (condition-case err + ;; If the input is multiple lines, + ;; process each line individually. + (while (string-match "\n" string) + (let ((request (substring string 0 (match-beginning 0))) + (coding-system (and default-enable-multibyte-characters + (or file-name-coding-system + default-file-name-coding-system))) + client nowait eval newframe display version-checked + registered ; t if the client is already added to server-clients. + (files nil) + (lineno 1) + (columnno 0)) + ;; Remove this line from STRING. + (setq string (substring string (match-end 0))) + (setq client (cons proc nil)) + (while (string-match "[^ ]* " request) + (let ((arg (substring request (match-beginning 0) (1- (match-end 0))))) (setq request (substring request (match-end 0))) - (server-with-errors-reported - (let ((frame (make-frame-on-tty tty type))) - (push (list (car client) (frame-tty-name frame)) server-ttys) - (process-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n")) - (select-frame frame) - ;; This makes sure that `emacsclient -t -e '(delete-frame)'' works right. - (push client server-clients) - (setq registered t - newframe t))))) - - ;; ARG is a line number option. - ((string-match "\\`\\+[0-9]+\\'" arg) - (setq lineno (string-to-int (substring arg 1)))) - - ;; ARG is line number:column option. - ((string-match "\\`\\+\\([0-9]+\\):\\([0-9]+\\)\\'" arg) - (setq lineno (string-to-int (match-string 1 arg)) - columnno (string-to-int (match-string 2 arg)))) - - ;; ARG is a filename or a Lisp expression. - (t - - ;; Undo the quoting that emacsclient does - ;; for certain special characters. - (setq arg (server-unquote-arg arg)) - ;; Now decode the file name if necessary. - (if coding-system - (setq arg (decode-coding-string arg coding-system))) - (if eval - (server-with-errors-reported - (let ((v (eval (car (read-from-string arg))))) - (when (and (not newframe) v) - (with-temp-buffer - (let ((standard-output (current-buffer))) - (pp v) - (process-send-string proc "-print ") - (process-send-region proc (point-min) (point-max))))))) - - ;; ARG is a file name. - ;; Collapse multiple slashes to single slashes. - (setq arg (command-line-normalize-file-name arg)) - (push (list arg lineno columnno) files)) - (setq lineno 1) - (setq columnno 0))))) - - (when files - (run-hooks 'pre-command-hook) - (server-visit-files files client nowait) - (run-hooks 'post-command-hook)) - ;; CLIENT is now a list (CLIENTNUM BUFFERS...) - (if (and (not newframe) (null (cdr client))) - ;; This client is empty; get rid of it immediately. - (progn - (delete-process proc) - (server-log "Close empty client" proc)) - ;; We visited some buffer for this client. - (or nowait registered (push client server-clients)) - (unless (or isearch-mode (minibufferp)) - (if (and newframe (null (cdr client))) - (message (substitute-command-keys - "When done with this frame, type \\[delete-frame]")) - (server-switch-buffer (nth 1 client)) - (run-hooks 'server-switch-hook) - (unless nowait - (message (substitute-command-keys - "When done with a buffer, type \\[server-edit]")))))))) - ;; Save for later any partial line that remains. - (when (> (length string) 0) - (process-put proc 'previous-string string))) + (cond + ;; Check version numbers. + ((and (equal "-version" arg) (string-match "\\([0-9.]+\\) " request)) + (let* ((client-version (match-string 1 request)) + (truncated-emacs-version (substring emacs-version 0 (length client-version)))) + (setq request (substring request (match-end 0))) + (if (equal client-version truncated-emacs-version) + (progn + (process-send-string proc "-good-version \n") + (setq version-checked t)) + (error (concat "Version mismatch: Emacs is " truncated-emacs-version ", emacsclient is " client-version))))) + + ((equal "-nowait" arg) (setq nowait t)) + ((equal "-eval" arg) (setq eval t)) + + ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request)) + (setq display (match-string 1 request) + request (substring request (match-end 0)))) + + ;; Open a new X frame. + ((equal "-window-system" arg) + (unless version-checked + (error "Protocol error; make sure to use the correct version of emacsclient")) + (let ((frame (make-frame-on-display + (or display + (frame-parameter nil 'display) + (getenv "DISPLAY") + (error "Please specify display"))))) + (push (list proc frame) server-frames) + (select-frame frame) + ;; This makes sure that `emacsclient -w -e '(delete-frame)'' works right. + (push client server-clients) + (setq registered t + newframe t))) + + ;; Open a new tty frame at the client. ARG is the name of the pseudo tty. + ((and (equal "-tty" arg) (string-match "\\([^ ]*\\) \\([^ ]*\\) " request)) + (let ((tty (server-unquote-arg (match-string 1 request))) + (type (server-unquote-arg (match-string 2 request)))) + (setq request (substring request (match-end 0))) + (unless version-checked + (error "Protocol error; make sure to use the correct version of emacsclient")) + (let ((frame (make-frame-on-tty tty type))) + (push (list (car client) (frame-tty-name frame)) server-ttys) + (process-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n")) + (select-frame frame) + ;; This makes sure that `emacsclient -t -e '(delete-frame)'' works right. + (push client server-clients) + (setq registered t + newframe t)))) + + ;; ARG is a line number option. + ((string-match "\\`\\+[0-9]+\\'" arg) + (setq lineno (string-to-int (substring arg 1)))) + + ;; ARG is line number:column option. + ((string-match "\\`\\+\\([0-9]+\\):\\([0-9]+\\)\\'" arg) + (setq lineno (string-to-int (match-string 1 arg)) + columnno (string-to-int (match-string 2 arg)))) + + ;; ARG is a filename or a Lisp expression. + (t + ;; Undo the quoting that emacsclient does + ;; for certain special characters. + (setq arg (server-unquote-arg arg)) + ;; Now decode the file name if necessary. + (if coding-system + (setq arg (decode-coding-string arg coding-system))) + (unless version-checked + (error "Protocol error; make sure to use the correct version of emacsclient")) + (if eval + ;; ARG is a Lisp expression. + (let ((v (eval (car (read-from-string arg))))) + (when (and (not newframe) v) + (with-temp-buffer + (let ((standard-output (current-buffer))) + (pp v) + (process-send-string proc "-print ") + (process-send-region proc (point-min) (point-max)))))) + ;; ARG is a file name. + ;; Collapse multiple slashes to single slashes. + (setq arg (command-line-normalize-file-name arg)) + (push (list arg lineno columnno) files)) + (setq lineno 1) + (setq columnno 0))))) + + (if (not version-checked) + (error "Protocol error; make sure to use the correct version of emacsclient") + (when files + (run-hooks 'pre-command-hook) + (server-visit-files files client nowait) + (run-hooks 'post-command-hook)) + ;; CLIENT is now a list (CLIENTNUM BUFFERS...) + (if (and (not newframe) (null (cdr client))) + ;; This client is empty; get rid of it immediately. + (progn + (delete-process proc) + (server-log "Close empty client" proc)) + ;; We visited some buffer for this client. + (or nowait registered (push client server-clients)) + (unless (or isearch-mode (minibufferp)) + (if (and newframe (null (cdr client))) + (message (substitute-command-keys + "When done with this frame, type \\[delete-frame]")) + (server-switch-buffer (nth 1 client)) + (run-hooks 'server-switch-hook) + (unless nowait + (message (substitute-command-keys + "When done with a buffer, type \\[server-edit]")))))))) + ;; Save for later any partial line that remains. + (when (> (length string) 0) + (process-put proc 'previous-string string))) + ;; condition-case + (error (ignore-errors + (process-send-string + proc (concat "-error " (error-message-string err))) + (setq string "") + (server-log (error-message-string err) proc) + (delete-process proc))))) (defun server-goto-line-column (file-line-col) (goto-line (nth 1 file-line-col)) -- 2.20.1