Enable cider-jack-in on tramp buffers

When using cider-jack-in in a tramp source buffer, starts a remote nrepl
server, and connects to it. By default, sets up an ssh tunnel to the
remote port. This can be controlled using nrepl-connection-endpoint,
which defaults to nrepl-connection-ssh-tunnel.

3 files changed, 129 insertions, 13 deletions

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 60f49f44..757886ee 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -8,6 +8,8 @@
 * Cider command uses `cider-known-endpoints`.
 * [#490](https://github.com/clojure-emacs/cider/pull/490) Dedicated
   support for `company-mode` in `cider-complete-at-point`.
+* [#489](https://github.com/clojure-emacs/cider/issues/489) Enable
+  cider-jack-in on tramp source buffers.
 * [#460](https://github.com/clojure-emacs/cider/issues/460) Support for
 cider-nrepl's complete middleware for CLJ/CLJS autocomplete.
 * [#465](https://github.com/clojure-emacs/cider/issues/465) Support for
diff --git a/cider.el b/cider.el
index 05e28ff0..4389d8ad 100644
--- a/cider.el
+++ b/cider.el
@@ -103,10 +103,17 @@ start the server."
              (cmd (if project
                       (format "cd %s && %s" project cider-server-command)
                     cider-server-command))
-             (process (start-process-shell-command
-                       "nrepl-server"
-                       (generate-new-buffer-name (nrepl-server-buffer-name))
-                       cmd)))
+             (default-directory project-dir)
+             (nrepl-buffer-name (generate-new-buffer-name
+                                 (nrepl-server-buffer-name)))
+             (process
+              (progn
+                ;; the buffer has to be created before the proc:
+                (get-buffer-create nrepl-buffer-name)
+                (start-file-process-shell-command
+                 "nrepl-server"
+                 nrepl-buffer-name
+                 cmd))))
         (set-process-filter process 'nrepl-server-filter)
         (set-process-sentinel process 'nrepl-server-sentinel)
         (set-process-coding-system process 'utf-8-unix 'utf-8-unix)
diff --git a/nrepl-client.el b/nrepl-client.el
index 6650ffd7..21f599a5 100644
--- a/nrepl-client.el
+++ b/nrepl-client.el
@@ -80,6 +80,18 @@ The `nrepl-buffer-name-separator' separates cider-repl from the project name."
   :type 'string
   :group 'nrepl)
 
+(defcustom nrepl-connection-endpoint
+  'nrepl-connection-ssh-tunnel
+  "A function that is called to determine command that will be run
+once an nrepl server process is running. Used to set up an ssh tunnel
+on remote connections.
+
+The arguments are dir and port. The return value
+should be an `plist` of the form
+(:proc-buffer-name \"*buf*\" :hostname \"hostname\" :port 1234)"
+  :type 'function
+  :group 'nrepl)
+
 (defvar nrepl-repl-requires-sexp "(clojure.core/apply clojure.core/require '[[clojure.repl :refer (source apropos dir pst doc find-doc)] [clojure.java.javadoc :refer (javadoc)] [clojure.pprint :refer (pp pprint)]])"
   "Things to require in the tooling session and the REPL buffer.")
 
@@ -88,10 +100,12 @@ The `nrepl-buffer-name-separator' separates cider-repl from the project name."
 (defvar-local nrepl-repl-buffer nil)
 (defvar-local nrepl-endpoint nil)
 (defvar-local nrepl-project-dir nil)
+(defvar-local nrepl-on-connection-buffer nil)
 
 (defconst nrepl-repl-buffer-name-template "*cider-repl%s*")
 (defconst nrepl-connection-buffer-name-template "*nrepl-connection%s*")
 (defconst nrepl-server-buffer-name-template "*nrepl-server%s*")
+(defconst nrepl-on-connection-buffer-name-template "*nrepl-on-connection%s*")
 
 (defcustom nrepl-hide-special-buffers nil
   "Control the display of some special buffers in buffer switching commands.
@@ -134,6 +148,11 @@ connection port if `nrepl-buffer-name-show-port' is true."
   (nrepl-apply-hide-special-buffers
    (nrepl-buffer-name nrepl-server-buffer-name-template)))
 
+(defun nrepl-on-connection-buffer-name ()
+  "Return the name of the on-connection buffer."
+  (nrepl-apply-hide-special-buffers
+   (nrepl-buffer-name nrepl-on-connection-buffer-name-template)))
+
 ;; buffer local declarations
 (defvar-local nrepl-session nil
   "Current nREPL session id.")
@@ -463,6 +482,8 @@ Also closes associated REPL and server buffers."
        (when (buffer-live-p buffer)
          (dolist (buf-name `(,(buffer-local-value 'nrepl-repl-buffer buffer)
                              ,(buffer-local-value 'nrepl-server-buffer buffer)
+                             ,(buffer-local-value
+                               'nrepl-on-connection-buffer buffer)
                              ,buffer))
            (when buf-name
              (cider--close-buffer buf-name)))))))
@@ -695,6 +716,26 @@ are processed."
   (nrepl-send-request-sync (nrepl-eval-request input ns session)))
 
 ;;; server
+(defun nrepl--default-endpoint (dir port)
+  "The endpoint for a repl in project DIR on PORT.
+Return a plist with :hostname, :port and :proc keys."
+    (list :hostname (if (file-remote-p dir)
+                        tramp-current-host
+                      "localhost")
+          :port port
+          :proc-buffer-name nil))
+
+(defun nrepl--endpoint-for-connection (dir port)
+  "Call any `nrepl-connection-endpoint' for DIR and PORT.
+Return a plist with :hostname and :port values, specifying where
+to connect, and a :proc-buffer-name key, specifying the name of a
+process buffer to associate with the connection.  When no
+`nrepl-connection-endpoint' is specified, returns a plist with
+the hostname associated with DIR, and PORT."
+  (if (functionp nrepl-connection-endpoint)
+      (funcall nrepl-connection-endpoint dir port)
+    (nrepl--default-endpoint dir port)))
+
 (defun nrepl-server-filter (process output)
   "Process nREPL server output from PROCESS contained in OUTPUT."
   (with-current-buffer (process-buffer process)
@@ -705,15 +746,21 @@ are processed."
     (let ((port (string-to-number (match-string 1 output))))
       (message (format "nREPL server started on %s" port))
       (with-current-buffer (process-buffer process)
-        (let ((nrepl-process (nrepl-connect "localhost" port)))
-          (setq nrepl-connection-buffer
-                (buffer-name (process-buffer nrepl-process)))
-          (with-current-buffer (process-buffer nrepl-process)
-            (setq nrepl-server-buffer
-                  (buffer-name (process-buffer process))
-                  nrepl-project-dir
-                  (buffer-local-value
-                   'nrepl-project-dir (process-buffer process)))))))))
+        (let* ((endpoint (nrepl--endpoint-for-connection
+                          default-directory port))
+               (hostname (plist-get endpoint :hostname))
+               (port (plist-get endpoint :port))
+               (proc-buffer-name (plist-get endpoint :proc-buffer-name)))
+          (let ((nrepl-process (nrepl-connect hostname port)))
+            (setq nrepl-connection-buffer
+                  (buffer-name (process-buffer nrepl-process)))
+            (with-current-buffer (process-buffer nrepl-process)
+              (setq nrepl-server-buffer
+                    (buffer-name (process-buffer process))
+                    nrepl-project-dir
+                    (buffer-local-value
+                     'nrepl-project-dir (process-buffer process))
+                    nrepl-on-connection-buffer proc-buffer-name))))))))
 
 (defun nrepl-server-sentinel (process event)
   "Handle nREPL server PROCESS EVENT."
@@ -735,6 +782,66 @@ are processed."
       (error "Leiningen 2.x is required by CIDER"))
      (t (error "Could not start nREPL server: %s" problem)))))
 
+(defun nrepl--ssh-tunnel-command (ssh dir port)
+  "Command string to open SSH tunnel to the host associated with DIR's PORT."
+  (with-parsed-tramp-file-name dir nil
+    (format-spec
+     "%s -v -N -L %p:localhost:%p %u'%h'"
+     `((?s . ,ssh)
+       (?p . ,port)
+       (?h . ,host)
+       (?u . ,(if user (format "-l '%s' " user) ""))))))
+
+(defun nrepl--ssh-tunnel-filter (port)
+  "Return a filter function for waiting on PORT to appear in output."
+  (let ((port-string (format "LOCALHOST:%s" port)))
+    (lambda (proc string)
+      (when (buffer-live-p (process-buffer proc))
+        (with-current-buffer (process-buffer proc)
+          (let ((moving (= (point) (process-mark proc))))
+            (save-excursion
+              (goto-char (process-mark proc))
+              (insert string)
+              (set-marker (process-mark proc) (point)))
+            (if moving (goto-char (process-mark proc))))))
+      (when (string-match port-string string)
+        (with-current-buffer (process-buffer proc)
+          (setq nrepl-wait-for-port nil))))))
+
+(defun nrepl-connection-ssh-tunnel (dir port)
+  "Return an endpoint for SSH tunnel to project DIR path, and PORT port.
+If DIR is remote, then attempt to open an SSH tunnel to port.  If
+the ssh executable is not found on the path, then fall back to
+specifying a direct conneciton."
+  ;; this abuses the -v option for ssh to get output when the port
+  ;; forwarding is set up, which is used to synchronise on, so that
+  ;; the port forwarding is up when we try to connect.
+  (if (file-remote-p dir)
+      (let ((ssh (executable-find "ssh")))
+        (if ssh
+            ;; run cmd in a local shell
+            (let* ((cmd (nrepl--ssh-tunnel-command ssh dir port))
+                   (on-connection-buffer-name (nrepl-on-connection-buffer-name))
+                   (proc (start-process-shell-command
+                          "nrepl-on-connection"
+                          on-connection-buffer-name
+                          cmd))
+                   (on-connection-buffer (get-buffer
+                                          on-connection-buffer-name)))
+              (with-current-buffer on-connection-buffer-name
+                (setq-local nrepl-wait-for-port t))
+              (set-process-filter proc (nrepl--ssh-tunnel-filter port))
+              (while (and (buffer-local-value 'nrepl-wait-for-port
+                                              on-connection-buffer)
+                          (process-live-p proc))
+                (accept-process-output nil 0.005))
+              (unless (process-live-p proc)
+                (message "SSH port forwarding failed"))
+              (list :hostname "localhost" :port port
+                    :proc-buffer-name on-connection-buffer-name))
+          (nrepl--default-endpoint dir port)))
+    (list :hostname "localhost" :port port :proc-buffer-name nil)))
+
 (defun nrepl-current-dir ()
   "Return the directory of the current buffer."
   (let ((file-name (buffer-file-name (current-buffer))))