Merge pull request #808 from vitoshka/cider-connect

bbatsov · bbatsov · commit 34ba8452d1f0 · 2014-09-21T23:18:14.000+03:00
`cider-connect`: auto-detect ssh hosts and all running repls on local and remote hosts
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -3,7 +3,9 @@
 ## master (unreleased)
 
 ### New features
-
+* `cider-connect` now asks for remote hosts defined in machine-wide `ssh`
+  configuration files and automatically detects running instances of lein
+  server, both on local and remote machines.
 * New defcustom `cider-stacktrace-print-level`.  Controls the `*print-level*` used when
   pretty printing an exception cause's data.  Defaults to 50.
 * New interactive command `cider-undef`.
diff --git a/cider-interaction.el b/cider-interaction.el
@@ -543,7 +543,9 @@ When invoked with a prefix ARG the command doesn't prompt for confirmation."
 Defaults to the current buffer.
 Return the tramp prefix, or nil if BUFFER is local."
   (let* ((buffer (or buffer (current-buffer)))
-         (name (buffer-file-name buffer)))
+         (name (or (buffer-file-name buffer)
+                   (with-current-buffer buffer
+                     default-directory))))
     (when (tramp-tramp-file-p name)
       (let ((vec (tramp-dissect-file-name name)))
         (tramp-make-tramp-file-name (tramp-file-name-method vec)
diff --git a/cider-util.el b/cider-util.el
@@ -157,6 +157,16 @@ to `fill-column'."
   "Join all STRINGS using SEPARATOR."
   (mapconcat 'identity strings separator))
 
+(defun cider-join-with-val-prop (candidates &optional sep)
+  "Each element EL in CANDIDATES join with SEP and set :val property to EL.
+Useful for `completing-read' when candidates are complex objects."
+  (mapcar (lambda (el)
+            (propertize (if (listp el)
+                            (cider-string-join el (or sep ":"))
+                          (format "%s" el))
+                        :val el))
+          candidates))
+
 (provide 'cider-util)
 
 ;;; cider-util.el ends here
diff --git a/cider.el b/cider.el
@@ -65,6 +65,7 @@
 (require 'cider-repl)
 (require 'cider-mode)
 (require 'cider-util)
+(require 'tramp-sh)
 
 (defvar cider-version "0.8.0-snapshot"
   "Fallback version used when it cannot be extracted automatically.
@@ -91,14 +92,17 @@ This variable is used by `cider-connect'."
   :type 'list
   :group 'cider)
 
-;; TODO: Implement a check for `cider-lein-command' over tramp
-(defun cider--lein-present-p ()
-  "Check if `cider-lein-command' is on the `exec-path'.
+(defvar cider-ps-running-nrepls-command "ps u | grep leiningen"
+  "Process snapshot command used in `cider-locate-running-nrepl-ports'.")
 
-In case `default-directory' is non-local we assume the command is available."
-  (or (file-remote-p default-directory)
-      (executable-find cider-lein-command)
-      (executable-find (concat cider-lein-command ".bat"))))
+(defvar cider-ps-running-nrepl-path-regexp-list
+  '("\\(?:leiningen.original.pwd=\\)\\([^ ]+\\)"
+    "\\(?:-classpath +:?\\(.+\\)/self-installs\\)")
+  "Regexp list to extract project paths from output of `cider-ps-running-nrepls-command'.
+Sub-match 1 must be the project path.")
+
+(defvar cider-host-history nil
+  "Completion history for connection hosts.")
 
 ;;;###autoload
 (defun cider-version ()
@@ -129,50 +133,110 @@ start the server."
     (message "The %s executable (specified by `cider-lein-command') isn't on your exec-path"
              cider-lein-command)))
 
-(defun cider-known-endpoint-candidates ()
-  "Known endpoint candidates for establishing an nREPL connection.
-A default will be included consisting of `nrepl-default-host' and
-`nrepl-default-port'."
-  (-distinct
-   (mapcar (lambda (endpoint)
-             (cider-string-join endpoint " "))
-           (cons (list (nrepl-current-host) (nrepl-default-port))
-                 cider-known-endpoints))))
-
-(defun cider-select-known-endpoint ()
-  "Select an endpoint from known endpoints.
-The returned endpoint has the label removed."
-  (let ((selected-endpoint (split-string
-                            (completing-read
-                             "Host: " (cider-known-endpoint-candidates)))))
-    (if (= 3 (length selected-endpoint))
-        (cdr selected-endpoint)
-      selected-endpoint)))
-
 ;;;###autoload
 (defun cider-connect (host port)
   "Connect to an nREPL server identified by HOST and PORT.
 Create REPL buffer and start an nREPL client connection."
-  (interactive (let ((known-endpoint (when cider-known-endpoints
-                                       (cider-select-known-endpoint))))
-                 (list (or (car known-endpoint)
-                           (read-string "Host: " (nrepl-current-host) nil (nrepl-current-host)))
-                       (string-to-number (let ((port (or (cadr known-endpoint) (nrepl-default-port))))
-                                           (read-string "Port: " port nil port))))))
+  (interactive (cider-select-endpoint))
   (setq cider-current-clojure-buffer (current-buffer))
   (when (nrepl-check-for-repl-buffer `(,host ,port) nil)
-    (nrepl-start-client-process default-directory host port t)))
+    (nrepl-start-client-process host port t)))
+
+(defun cider-select-endpoint ()
+  "Interactively select the host and port to connect to."
+  (let* ((ssh-hosts (cider--ssh-hosts))
+         (hosts (-distinct (append (when cider-host-history 
+                                     (list (car cider-host-history )))
+                                   (list (list (nrepl-current-host)))
+                                   cider-known-endpoints
+                                   ssh-hosts
+                                   (when (file-remote-p default-directory)
+                                     ;; add localhost even in remote buffers
+                                     (list (list "localhost"))))))
+         (sel-host (cider--completing-read-host hosts))
+         (host (car sel-host))
+         (local-p (or  (nrepl-local-host-p host)
+                       (not (assoc-string host ssh-hosts))))
+         ;; Each lein-port is a list of the form (dir port)
+         (lein-ports (if local-p
+                         (let ((default-directory (if (file-remote-p default-directory)
+                                                      "~/"
+                                                    default-directory)))
+                           (cider-locate-running-nrepl-ports))
+                       (let ((vec (vector "ssh" nil host "" nil)))
+                         (tramp-maybe-open-connection vec)
+                         (with-current-buffer (tramp-get-connection-buffer vec)
+                           (cider-locate-running-nrepl-ports)))))
+         (ports (append (cdr sel-host) lein-ports))
+         (port (cider--completing-read-port host ports)))
+    (setq cider-host-history (cons sel-host (delete sel-host cider-host-history)))
+    (list host port)))
+
+(defun cider--ssh-hosts ()
+  "Retrieve all ssh host from local configuration files."
+  (-map (lambda (s) (list (replace-regexp-in-string ":$" "" s)))
+        (let ((tramp-completion-mode t))
+          (tramp-completion-handle-file-name-all-completions "" "/ssh:"))))
+
+(defun cider--completing-read-host (hosts)
+  "Interactively select host from HOSTS.
+Each element in HOSTS is one of: (host), (host port) or (label host port).
+Return a list of the form (HOST PORT), where PORT can be nil."
+  (let* ((sel-host (completing-read "Host: " (cider-join-with-val-prop hosts)))
+         (host (or (get-text-property 1 :val sel-host) (list sel-host))))
+    ;; remove the label
+    (if (= 3 (length host)) (cdr host) host)))
+
+(defun cider--completing-read-port (host ports)
+  "Interactively select port for HOST from PORTS."
+  (let* ((sel-port (completing-read (format "Port for %s: " host)
+                                    (cider-join-with-val-prop ports)))
+         (port (or (get-text-property 1 :val sel-port) sel-port)))
+    (if (listp port) (second port) port)))
+
+(defun cider-locate-running-nrepl-ports ()
+  "Locate ports of running nREPL servers.
+Return a list of list of the form (project-dir port)."
+  (let ((paths (cider--get-running-nrepl-paths)))
+    (delq nil
+          (mapcar (lambda (f)
+                    (-when-let (port-file (or (cider--file-path (concat f "/.nrepl-port"))
+                                              (cider--file-path (concat f "/repl-port"))))
+                      (with-temp-buffer
+                        (insert-file-contents port-file)
+                        (list (file-name-nondirectory f) (buffer-string)))))
+                  paths))))
+
+(defun cider--get-running-nrepl-paths ()
+  "Retrieve project paths of running nREPL servers.
+use `cider-ps-running-nrepls-command' and `cider-ps-running-nrepl-path-regexp-list'."
+  (let (paths)
+    (with-temp-buffer
+      (insert (shell-command-to-string cider-ps-running-nrepls-command))
+      (dolist (regexp cider-ps-running-nrepl-path-regexp-list)
+        (goto-char 1)
+        (while (re-search-forward regexp nil t)
+          (setq paths (cons (match-string 1) paths)))))
+    (-distinct paths)))
 
-(define-obsolete-function-alias
-  'cider
-  'cider-connect)
+;; TODO: Implement a check for `cider-lein-command' over tramp
+(defun cider--lein-present-p ()
+  "Check if `cider-lein-command' is on the `exec-path'.
+
+In case `default-directory' is non-local we assume the command is available."
+  (or (file-remote-p default-directory)
+      (executable-find cider-lein-command)
+      (executable-find (concat cider-lein-command ".bat"))))
 
 ;;;###autoload
 (eval-after-load 'clojure-mode
   '(progn
      (define-key clojure-mode-map (kbd "C-c M-j") 'cider-jack-in)
      (define-key clojure-mode-map (kbd "C-c M-c") 'cider-connect)))
 
+
+(define-obsolete-function-alias 'cider 'cider-connect)
+
 (provide 'cider)
 
 ;;; cider.el ends here
diff --git a/nrepl-client.el b/nrepl-client.el
@@ -251,6 +251,10 @@ Bind the value of the provided KEYS and execute BODY."
           (file-name-directory file-name))
         list-buffers-directory)))
 
+(defun nrepl-local-host-p (host)
+  "Return t if HOST is local."
+  (string-match-p tramp-local-host-regexp host))
+
 (defun nrepl-project-directory-for (dir-name)
   "Return the project directory for the specified DIR-NAME."
   (when dir-name
@@ -587,22 +591,20 @@ process buffer and run the hook `nrepl-disconnected-hook'."
 ;; `nrepl-start-client-process' is called from `nrepl-server-filter'. It
 ;; starts the client process described by `nrepl-client-filter' and
 ;; `nrepl-client-sentinel'.
-(defun nrepl-start-client-process (&optional directory host port replp server-proc)
-  "Create new client process identified by DIRECTORY, HOST and PORT.
-If DIRECTORY is nil, use `default-directory'.  If eitehr HOST or PORT are
-nil, pick them from the value returned by `nrepl-connection-endpoint'.  If
-REPLP is non-nil create a client connection which is associated with a repl
-buffer.  When non-nil, SERVER-PROC must be a running nrepl server process
-within Emacs.  Return the newly created client connection process."
-  (let* ((endpoint (unless (and host port)
-                     (nrepl-connection-endpoint directory port)))
-         (directory (or directory default-directory))
-         (host (or host (plist-get endpoint :hostname)))
-         (port (or port (plist-get endpoint :port)))
+(defun nrepl-start-client-process (&optional host port replp server-proc)
+  "Create new client process identified by HOST and PORT.
+If eitehr HOST or PORT are nil, pick them from the value returned by
+`nrepl-connection-endpoint'.  If REPLP is non-nil create a client
+connection which is associated with a repl buffer.  When non-nil,
+SERVER-PROC must be a running nrepl server process within Emacs.  Return
+the newly created client connection process."
+  (let* ((endpoint (nrepl-connection-endpoint host port))
+         (host (plist-get endpoint :host))
+         (port (plist-get endpoint :port))
          (server-buf (and server-proc (process-buffer server-proc)))
          (client-buf (if replp
-                         (cider-repl-create directory host port)
-                       (nrepl-create-connection-buffer directory host port)))
+                         (cider-repl-create default-directory host port)
+                       (nrepl-create-connection-buffer default-directory host port)))
          (client-proc (open-network-stream "nrepl" client-buf host port))
          (tunnel-proc (plist-get endpoint :proc))
          (nrepl-connection-dispatch client-buf))
@@ -872,8 +874,7 @@ Return a newly created process."
     (let ((port (string-to-number (match-string 1 output))))
       (message (format "nREPL server started on %s" port))
       (with-current-buffer (process-buffer process)
-        (let ((client-proc (nrepl-start-client-process
-                            default-directory nil port t process)))
+        (let ((client-proc (nrepl-start-client-process nil port t process)))
           ;; FIXME: Bad connection tracking system. There can be multiple client
           ;; connections per server
           (setq nrepl-connection-buffer (buffer-name (process-buffer client-proc))))))))
@@ -898,36 +899,40 @@ Return a newly created process."
       (error "Leiningen 2.x is required by CIDER"))
      (t (error "Could not start nREPL server: %s" problem)))))
 
-(defun nrepl-connection-endpoint (dir port)
+(defun nrepl-connection-endpoint (host port)
   "Return a connection endpoint.
 The returned endpoint is a `plist` of the form:
 
- (:proc PROCESS :hostname \"hostname\" :port 1234)
+ (:proc PROCESS :host \"hostname\" :port 1234)
 
-If DIR is local :proc is nil, :hostname is \"localhost\" and :port is PORT.
+If HOST is local :proc will be nil, :host - \"localhost\" and :port - PORT.
 
-If DIR is remote and `ssh' executable has been found, attempt to start an
-SSH tunnel and return it as :proc.  If no `ssh' executable has been found,
-fall back to specifying a direct connection to the remote host."
-  (if (file-remote-p dir)
+If HOST is nil and `default-directory' is remote, or if HOST is remote
+attempt to start an SSH tunnel and return it as :proc slot.  If no `ssh'
+executable has been found, fall back to specifying a direct connection to
+the remote host."
+  (let ((localp (if host
+                    (nrepl-local-host-p host)
+                  (not (file-remote-p default-directory)))))
+    (if localp
+        (list :host (or host "localhost") :port port :proc nil)
       (let ((ssh (executable-find "ssh")))
-        (if ssh
-            ;; run cmd in a local shell
-            (let* ((cmd (nrepl--ssh-tunnel-command ssh dir port))
-                   (proc (start-process-shell-command
-                          "nrepl-tunnel"
-                          (nrepl-tunnel-buffer-name)
-                          cmd)))
-              (process-put proc :waiting-for-port t)
-              (set-process-filter proc (nrepl--ssh-tunnel-filter port))
-              (while (and (process-live-p proc)
-                          (process-get proc :waiting-for-port))
-                (accept-process-output nil 0.005))
-              (unless (process-live-p proc)
-                (message "SSH port forwarding failed"))
-              (list :hostname "localhost" :port port :proc proc))
-          (list :hostname tramp-current-host :port port :proc nil)))
-    (list :hostname "localhost" :port port :proc nil)))
+          (if ssh
+              ;; create a tunnel
+              (let* ((remote-dir (if host (format "/ssh:%s:" host) default-directory))
+                     (cmd (nrepl--ssh-tunnel-command ssh remote-dir port))
+                     (proc (start-process-shell-command
+                            "nrepl-tunnel" (nrepl-tunnel-buffer-name) cmd)))
+                (process-put proc :waiting-for-port t)
+                (set-process-filter proc (nrepl--ssh-tunnel-filter port))
+                (while (and (process-live-p proc)
+                            (process-get proc :waiting-for-port))
+                  (accept-process-output nil 0.005))
+                (unless (process-live-p proc)
+                  (message "SSH port forwarding failed"))
+                (list :host "localhost" :port port :proc proc))
+            ;; try a direct connection
+            (list :host tramp-current-host :port port :proc nil))))))
 
 (defun nrepl--ssh-tunnel-command (ssh dir port)
   "Command string to open SSH tunnel to the host associated with DIR's PORT."
diff --git a/test/cider-tests.el b/test/cider-tests.el
@@ -455,25 +455,6 @@
       (dolist (buf (list b1 b2 b3 b1-repl b2-repl b3-repl))
         (kill-buffer buf)))))
 
-(ert-deftest test-cider-known-endpoint-candidates ()
-  (let ((cider-known-endpoints '(("label" "host" "port"))))
-    (noflet ((nrepl-current-host () "current-host")
-             (nrepl-default-port () "current-port"))
-      (should (equal '("current-host current-port" "label host port")
-                     (cider-known-endpoint-candidates))))))
-
-(ert-deftest test-cider-known-endpoint-candidates-remove-duplicates ()
-  (let ((cider-known-endpoints '(("label" "host" "port") ("label" "host" "port"))))
-    (noflet ((nrepl-current-host () "current-host")
-             (nrepl-default-port () "current-port"))
-      (should (equal '("current-host current-port" "label host port")
-                     (cider-known-endpoint-candidates))))))
-
-(ert-deftest test-cider-select-known-endpoint-remove-label ()
-  (noflet ((cider-known-endpoint-candidates () '())
-           (completing-read (dontcare dontcare) "label host port"))
-    (should (equal '("host" "port") (cider-select-known-endpoint)))))
-
 (ert-deftest test-cider-change-buffers-designation ()
   (with-temp-buffer
     (let ((server-buffer (current-buffer)))
