Fix lsp-mode's tramp support (#4204)

* Fix lsp-mode's tramp support

- This fixes the implementation of `lsp-mode` tramp support. After this PR the
remote clients will be automatically registered and in most of the cases it will
work out of the box. The remote connection is managed to a way similar to what
eglot does.

Fixes #4158
Fixes #4150
Fixes #4158
Fixes #4150
Fixes #3841
Fixes #3642
Fixes #3579
Fixes #3530
Fixes #3491
Fixes #3490
Fixes #3391
Fixes #3369
Fixes #3364
Fixes #3020
Fixes #3018
Fixes #3020

* Use executable-find with remote = t everywhere

Author: yyoncho

docs/manual-language-docs/lsp-rust-analyzer.md

@@ -119,22 +119,3 @@ In the example below, first you see that:
 
 This [unmerged PR](https://github.com/emacs-lsp/lsp-mode/pull/1740) contains an example method that allows
 modifying the signature that is displayed by eldoc.
-
-### TRAMP Example
-
-The following is an example configuration for using lsp-mode with a remote rust-analyzer server:
-
-```
-(with-eval-after-load "lsp-rust"
-  (lsp-register-client
-   (make-lsp-client
-    :new-connection (lsp-tramp-connection "rust-analyzer")
-    :remote? t
-    :major-modes '(rust-mode rustic-mode)
-    :initialization-options 'lsp-rust-analyzer--make-init-options
-    :notification-handlers (ht<-alist lsp-rust-notification-handlers)
-    :action-handlers (ht ("rust-analyzer.runSingle" #'lsp-rust--analyzer-run-single))
-    :library-folders-fn (lambda (_workspace) lsp-rust-analyzer-library-directories)
-    :ignore-messages nil
-    :server-id 'rust-analyzer-remote)))
-```

docs/page/remote.md

@@ -5,33 +5,14 @@ root_file: docs/page/remote.md
 
 ## TRAMP
 
-LSP mode has support for tramp buffers with the following requirements:
+`lsp-mode` has support for tramp buffers with the following requirements:
 
 - The language server has to be present on the remote server.
 - Having multi folder language server (like [Eclipse JDT LS](https://github.com/eclipse/eclipse.jdt.ls)) cannot have local and remote workspace folders.
 
 ### How does it work?
 
-`lsp-mode` detects whether a particular file is located on remote machine and looks for a client which matches current file and it is marked as `:remote?` t. Then `lsp-mode` starts the client through tramp.
-
-### Sample configuration
-
-Here it is example how you can configure python language server to work when using `TRAMP`. Note that if you are trying to convert existing language server configuration you should copy all of it's properties(e. g. `:request-handlers`, `activation-fn`, etc). Also, when you are doing that you should make sure that none of the custom language server settings are not pointing to local path because those settings will be sent to the remote server.
-
-```elisp
-(lsp-register-client
-    (make-lsp-client :new-connection (lsp-tramp-connection "<binary name (e. g. pyls, rls)>")
-                     :major-modes '(python-mode)
-                     :remote? t
-                     :server-id 'pyls-remote))
-```
-
-_Note:_ when you do not have root privileges on the remote machine to put the language server on the path you may alter the remote path by changing `tramp-remote-path`.
-
-### Dealing with stderr
-
-With TRAMP, Emacs does not have an easy way to distinguish stdout and stderr, so when the underlying LSP process writes to stderr, it breaks the `lsp-mode` parser. As a workaround, `lsp-mode` is redirecting stderr to `/tmp/<process-name>-<id>~stderr`.
-
+`lsp-mode` detects whether a particular file is located on remote machine and looks for a client which matches current file and it is marked as `:remote?` t. Then `lsp-mode` starts the client through tramp. By default `lsp-mode` will copy the local client and mark it as `remote? t`. In most of the cases it is good enough but certain cases this may not work (e. g. if the server configuration contains references to local paths). In this case the user is supposed to create `.dir-local` configuration to override the references to local paths or open an issue on `lsp-mode` side to make the setting remote agnostic. To turn of automatic remote clients registration you can set `lsp-auto-register-remote-clients` to `nil`.
 
 ## Docker
 

lsp-mode.el

@@ -1145,7 +1145,7 @@ calling `remove-overlays'.")
 
 (defvar-local lsp--virtual-buffer-point-max nil)
 
-(cl-defgeneric lsp-execute-command (server command arguments)
+(cl-defmethod lsp-execute-command (server command arguments)
   "Ask SERVER to execute COMMAND with ARGUMENTS.")
 
 (defun lsp-elt (sequence n)
@@ -5422,6 +5422,12 @@ In addition, each can have property:
   :type 'boolean
   :package-version '(lsp-mode . "8.0.1"))
 
+(defcustom lsp-auto-register-remote-clients t
+  "When non-nil register remote when registering the local one."
+  :group 'lsp-mode
+  :type 'boolean
+  :package-version '(lsp-mode . "8.0.1"))
+
 (defun lsp--display-inline-image (mode)
   "Add image property if available."
   (let ((plist-list (cdr (assq mode lsp--display-inline-image-alist))))
@@ -5524,7 +5530,7 @@ When language is nil render as markup if `markdown-mode' is loaded."
     ;; render the first line.
     (_ (lsp-clients-extract-signature-on-hover contents nil))))
 
-(cl-defgeneric lsp-clients-extract-signature-on-hover (contents _server-id)
+(cl-defmethod lsp-clients-extract-signature-on-hover (contents _server-id)
   "Extract a representative line from CONTENTS, to show in the echo area."
   (car (s-lines (s-trim (lsp--render-element contents)))))
 
@@ -7285,28 +7291,29 @@ Return a nested alist keyed by symbol names. e.g.
   (when menu-bar-mode
     (lsp--imenu-refresh)))
 
-(defun lsp-resolve-final-function (command)
+(defun lsp-resolve-final-command (command &optional test?)
   "Resolve final function COMMAND."
-  (-let [command (if (functionp command) (funcall command) command)]
-    (cl-etypecase command
-      (list
-       (cl-assert (seq-every-p (apply-partially #'stringp) command) nil
-                  "Invalid command list")
-       command)
-      (string (list command)))))
+  (let* ((command (lsp-resolve-value command))
+         (command (cl-etypecase command
+                    (list
+                     (cl-assert (seq-every-p (apply-partially #'stringp) command) nil
+                                "Invalid command list")
+                     command)
+                    (string (list command)))))
+    (if (and (file-remote-p default-directory) (not test?))
+        (list shell-file-name "-c"
+              (string-join (cons "stty raw > /dev/null;"
+                                 (mapcar #'shell-quote-argument command))
+                           " "))
+      command)))
 
 (defun lsp-server-present? (final-command)
   "Check whether FINAL-COMMAND is present."
-  ;; executable-find only gained support for remote checks after 27 release
-  (or (and (cond
-            ((not (file-remote-p default-directory))
-             (executable-find (cl-first final-command)))
-            ((version<= "27.0" emacs-version)
-             (with-no-warnings (executable-find (cl-first final-command) (file-remote-p default-directory))))
-            (t))
-           (prog1 t
-             (lsp-log "Command \"%s\" is present on the path." (s-join " " final-command))))
-      (ignore (lsp-log "Command \"%s\" is not present on the path." (s-join " " final-command)))))
+  (let ((binary-found? (executable-find (cl-first final-command) t)))
+    (if binary-found?
+        (lsp-log "Command \"%s\" is present on the path." (s-join " " final-command))
+      (lsp-log "Command \"%s\" is not present on the path." (s-join " " final-command)))
+    binary-found?))
 
 (defun lsp--value-to-string (value)
   "Convert VALUE to a string that can be set as value in an environment
@@ -7343,6 +7350,17 @@ corresponding to PATH, else returns `default-directory'."
       (lsp-workspace-root path)
     default-directory))
 
+(defun lsp--fix-remote-cmd (program)
+  "Helper for `lsp-stdio-connection'.
+Originally coppied from eglot."
+
+  (if (file-remote-p default-directory)
+      (list shell-file-name "-c"
+            (string-join (cons "stty raw > /dev/null;"
+                               (mapcar #'shell-quote-argument program))
+                         " "))
+    program))
+
 (defun lsp-stdio-connection (command &optional test-command)
   "Returns a connection property list using COMMAND.
 COMMAND can be: A string, denoting the command to launch the
@@ -7362,26 +7380,28 @@ returned by COMMAND is available via `executable-find'"
                                                               (stringp el))
                                                             l))))))
   (list :connect (lambda (filter sentinel name environment-fn workspace)
-                   (if (functionp 'json-rpc-connection)
-                       (lsp-json-rpc-connection
-                        workspace
-                        (lsp-resolve-final-function command))
-                     (let ((final-command (lsp-resolve-final-function command))
+                   (if (and (functionp 'json-rpc-connection)
+                            (not (file-remote-p default-directory)))
+                       (lsp-json-rpc-connection workspace (lsp-resolve-final-command command))
+                     (let ((final-command (lsp-resolve-final-command command))
                            (process-name (generate-new-buffer-name name))
                            (process-environment
                             (lsp--compute-process-environment environment-fn)))
-                       (let* ((stderr-buf (format "*%s::stderr*" process-name))
+                       (let* ((stderr-buf (get-buffer-create (format "*%s::stderr*" process-name)))
                               (default-directory (lsp--default-directory-for-connection))
+                              (tramp-use-ssh-controlmaster-options 'suppress)
+                              (tramp-ssh-controlmaster-options "-o ControlMaster=no -o ControlPath=none")
                               (proc (make-process
                                      :name process-name
                                      :connection-type 'pipe
                                      :buffer (format "*%s*" process-name)
-                                     :coding 'no-conversion
+                                     :coding 'utf-8-emacs-unix
                                      :command final-command
                                      :filter filter
                                      :sentinel sentinel
                                      :stderr stderr-buf
-                                     :noquery t)))
+                                     :noquery t
+                                     :file-handler t)))
                          (set-process-query-on-exit-flag proc nil)
                          (set-process-query-on-exit-flag (get-buffer-process stderr-buf) nil)
                          (with-current-buffer (get-buffer stderr-buf)
@@ -7390,7 +7410,8 @@ returned by COMMAND is available via `executable-find'"
                          (cons proc proc)))))
         :test? (or
                 test-command
-                (lambda () (-> command lsp-resolve-final-function lsp-server-present?)))))
+                (lambda ()
+                  (lsp-server-present? (lsp-resolve-final-command command t))))))
 
 (defun lsp--open-network-stream (host port name)
   "Open network stream to HOST:PORT.
@@ -7440,7 +7461,7 @@ process listening for TCP connections on the provided port."
                      (port (lsp--find-available-port host (cl-incf lsp--tcp-port)))
                      (command (funcall command-fn port))
                      (final-command (if (consp command) command (list command)))
-                     (_ (unless (executable-find (cl-first final-command))
+                     (_ (unless (lsp-server-present? final-command)
                           (user-error (format "Couldn't find executable %s" (cl-first final-command)))))
                      (process-environment
                       (lsp--compute-process-environment environment-fn))
@@ -7453,7 +7474,7 @@ process listening for TCP connections on the provided port."
                 (set-process-query-on-exit-flag tcp-proc nil)
                 (set-process-filter tcp-proc filter)
                 (cons tcp-proc proc)))
-   :test? (lambda () (executable-find (cl-first (funcall command-fn 0))))))
+   :test? (lambda () (lsp-server-present? (funcall command-fn 0)))))
 
 (defalias 'lsp-tcp-server 'lsp-tcp-server-command)
 
@@ -7504,37 +7525,9 @@ should return the command to start the LS server."
                 (set-process-filter tcp-client-connection filter)
                 (set-process-sentinel tcp-client-connection sentinel)
                 (cons tcp-client-connection cmd-proc)))
-   :test? (lambda () (executable-find (cl-first (funcall command-fn 0))))))
-
-(defun lsp-tramp-connection (local-command &optional generate-error-file-fn)
-  "Create LSP stdio connection named name.
-LOCAL-COMMAND is either list of strings, string or function which
-returns the command to execute."
-  (list :connect (lambda (filter sentinel name environment-fn _workspace)
-                   (let* ((final-command (lsp-resolve-final-function local-command))
-                          ;; wrap with stty to disable converting \r to \n
-                          (process-name (generate-new-buffer-name name))
-                          (wrapped-command (s-join
-                                            " "
-                                            (append '("stty" "raw" ";")
-                                                    final-command
-                                                    (list
-                                                     (concat "2>"
-                                                             (or (when generate-error-file-fn
-                                                                   (funcall generate-error-file-fn name))
-                                                                 (format "/tmp/%s-%s-stderr" name
-                                                                         (cl-incf lsp--stderr-index))))))))
-                          (process-environment
-                           (lsp--compute-process-environment environment-fn)))
-                     (let ((proc (start-file-process-shell-command process-name
-                                                                   (format "*%s*" process-name)
-                                                                   wrapped-command)))
-                       (set-process-sentinel proc sentinel)
-                       (set-process-filter proc filter)
-                       (set-process-query-on-exit-flag proc nil)
-                       (set-process-coding-system proc 'binary 'binary)
-                       (cons proc proc))))
-        :test? (lambda () (-> local-command lsp-resolve-final-function lsp-server-present?))))
+   :test? (lambda () (lsp-server-present? (funcall command-fn 0)))))
+
+(defalias 'lsp-tramp-connection 'lsp-stdio-connection)
 
 (defun lsp--auto-configure ()
   "Autoconfigure `company', `flycheck', `lsp-ui', etc if they are installed."
@@ -8066,7 +8059,7 @@ nil."
     (if (and (f-absolute? path)
              (f-exists? path))
         path
-      (executable-find path))))
+      (executable-find path t))))
 
 (defun lsp-package-path (dependency)
   "Path to the DEPENDENCY each of the registered providers."
@@ -8099,7 +8092,8 @@ nil."
                (f-join lsp-server-install-dir "npm" package
                        (cond ((eq system-type 'windows-nt) "")
                              (t "bin"))
-                       path))))
+                       path)
+               t)))
     (unless (and path (f-exists? path))
       (error "The package %s is not installed.  Unable to find %s" package path))
     path))
@@ -8362,10 +8356,7 @@ the next question until the queue is empty."
   (->> lsp-clients hash-table-values (-filter pred)))
 
 (defun lsp--find-clients ()
-  "Find clients which can handle BUFFER-MAJOR-MODE.
-SESSION is the currently active session. The function will also
-pick only remote enabled clients in case the FILE-NAME is on
-remote machine and vice versa."
+  "Find clients which can handle current buffer."
   (-when-let (matching-clients (lsp--filter-clients (-andfn #'lsp--supports-buffer?
                                                             #'lsp--server-binary-present?)))
     (lsp-log "Found the following clients for %s: %s"
@@ -8398,23 +8389,25 @@ remote machine and vice versa."
   (--each (lsp-session-folders (lsp-session))
     (lsp-workspace-folders-remove it)))
 
-
 (defun lsp-register-client (client)
   "Registers LSP client CLIENT."
-  (cl-assert (symbolp (lsp--client-server-id client)) t)
-  (cl-assert (or
-              (functionp (lsp--client-activation-fn client))
-              (and (listp (lsp--client-major-modes client))
-                   (seq-every-p (apply-partially #'symbolp)
-                                (lsp--client-major-modes client))))
-             nil "Invalid activation-fn and/or major-modes.")
   (let ((client-id (lsp--client-server-id client)))
     (puthash client-id client lsp-clients)
     (setplist (intern (format "lsp-%s-after-open-hook" client-id))
               `( standard-value (nil) custom-type hook
                  custom-package-version (lsp-mode . "7.0.1")
                  variable-documentation ,(format "Hooks to run after `%s' server is run." client-id)
-                 custom-requests nil))))
+                 custom-requests nil)))
+  (when (and lsp-auto-register-remote-clients
+             (not (lsp--client-remote? client)))
+    (let ((remote-client (copy-lsp--client client)))
+      (setf (lsp--client-remote? remote-client) t
+            (lsp--client-server-id remote-client) (intern
+                                                   (format "%s-tramp"
+                                                           (lsp--client-server-id client)))
+            ;; disable automatic download
+            (lsp--client-download-server-fn client) nil)
+      (lsp-register-client remote-client))))
 
 (defun lsp--create-initialization-options (_session client)
   "Create initialization-options from SESSION and CLIENT.
@@ -8581,24 +8574,24 @@ When ALL is t, erase all log buffers of the running session."
 
 
 
-(cl-defgeneric lsp-process-id ((process process))
+(cl-defmethod lsp-process-id ((process process))
   (process-id process))
 
-(cl-defgeneric lsp-process-name ((process process)) (process-name process))
+(cl-defmethod lsp-process-name ((process process)) (process-name process))
 
-(cl-defgeneric lsp-process-status ((process process)) (process-status process))
+(cl-defmethod lsp-process-status ((process process)) (process-status process))
 
-(cl-defgeneric lsp-process-kill ((process process))
+(cl-defmethod lsp-process-kill ((process process))
   (when (process-live-p process)
     (kill-process process)))
 
-(cl-defgeneric lsp-process-send ((process process) message)
+(cl-defmethod lsp-process-send ((process process) message)
   (condition-case err
       (process-send-string process (lsp--make-message message))
     ('error (lsp--error "Sending to process failed with the following error: %s"
                         (error-message-string err)))))
 
-(cl-defgeneric lsp-process-cleanup (process)
+(cl-defmethod lsp-process-cleanup (process)
   ;; Kill standard error buffer only if the process exited normally.
   ;; Leave it intact otherwise for debugging purposes.
   (let ((buffer (-> process process-name get-buffer)))