Skip to content

Commit

Permalink
Merge pull request #756 from vitoshka/ssh-tunnel
Browse files Browse the repository at this point in the history 
Rename on-connection-* into tunnel-* and simplify related code.
  • Loading branch information
@bbatsov
bbatsov committed Sep 13, 2014
2 parents 08f48fb + 67615c9 commit 017e708
Showing 1 changed file with 47 additions and 71 deletions.
118 changes: 47 additions & 71 deletions nrepl-client.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -122,33 +122,20 @@ Setting this to nil disables the timeout functionality."
:type 'integer
: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)

(defcustom nrepl-hide-special-buffers nil
"Control the display of some special buffers in buffer switching commands.
When true some special buffers like the connection and the server
buffer will be hidden."
:type 'boolean
:group 'nrepl)



;;; nREPL Buffer Names

(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*")
(defconst nrepl-tunnel-buffer-name-template "*nrepl-tunnel%s*")

(defun nrepl-format-buffer-name-template (buffer-name-template designation)
"Apply the DESIGNATION to the corresponding BUFFER-NAME-TEMPLATE."
Expand All @@ -160,8 +147,8 @@ buffer will be hidden."
(defun nrepl-make-buffer-name (buffer-name-template &optional project-dir host port)
"Generate a buffer name using BUFFER-NAME-TEMPLATE.
If not supplied PROJECT-DIR, PORT and HOST default to the buffer local value of the
`nrepl-project-dir' and `nrepl-endpoint'.
If not supplied PROJECT-DIR, PORT and HOST default to the buffer local
value of the `nrepl-project-dir' and `nrepl-endpoint'.
The name will include the project name if available or the endpoint host if
it is not. The name will also include the connection port if
Expand Down Expand Up @@ -193,11 +180,11 @@ PROJECT-DIR, HOST and PORT are as in `nrepl-make-buffer-name'."
(nrepl-make-buffer-name nrepl-server-buffer-name-template
project-dir host port)))

(defun nrepl-on-connection-buffer-name (&optional project-dir host port)
"Return the name of the on-connection buffer.
(defun nrepl-tunnel-buffer-name (&optional project-dir host port)
"Return the name of the tunnel buffer.
PROJECT-DIR, HOST and PORT are as in `nrepl-make-buffer-name'."
(nrepl--make-hidden-name
(nrepl-make-buffer-name nrepl-on-connection-buffer-name-template
(nrepl-make-buffer-name nrepl-tunnel-buffer-name-template
project-dir host port)))


Expand All @@ -209,7 +196,7 @@ PROJECT-DIR, HOST and PORT are as in `nrepl-make-buffer-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)
(defvar-local nrepl-tunnel-buffer nil)

(defvar-local nrepl-session nil
"Current nREPL session id.")
Expand Down Expand Up @@ -501,19 +488,18 @@ 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 (if (functionp nrepl-connection-endpoint)
(funcall nrepl-connection-endpoint directory port)
(nrepl--default-endpoint directory port)))
(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)))
(proc-buffer-name (plist-get endpoint :proc-buffer-name))
(server-buf (and server-proc
(buffer-name (process-buffer server-proc))))
(client-buf (if replp
(cider-repl-create directory host port)
(nrepl-create-connection-buffer directory host port)))
(client-proc (open-network-stream "nrepl" client-buf host port))
(tunnel-proc (plist-get endpoint :proc))
(nrepl-connection-dispatch client-buf))

(set-process-filter client-proc 'nrepl-client-filter)
Expand All @@ -532,10 +518,10 @@ within Emacs. Return the newly created client connection process."
;; fixme: repl and connection buffers are the same thing
nrepl-connection-buffer client-buf
nrepl-repl-buffer (when replp client-buf)
nrepl-on-connection-buffer proc-buffer-name
nrepl-tunnel-buffer (and tunnel-proc (process-buffer tunnel-proc))
nrepl-pending-requests (make-hash-table :test 'equal)
nrepl-completed-requests (make-hash-table :test 'equal)))

(nrepl-make-connection-default client-buf)

;; Everything is set. We are ready to send requests.
Expand Down Expand Up @@ -844,52 +830,43 @@ 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-ssh-tunnel (dir port)
"Return an endpoint for SSH tunnel to project DIR stack, 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 stack, 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.
(defun nrepl-connection-endpoint (dir port)
"Return a connection endpoint.
The returned endpoint is a `plist` of the form:
(:proc PROCESS :hostname \"hostname\" :port 1234)
If DIR is local :proc is nil, :hostname is \"localhost\" and :port is 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)
(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))
"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 (buffer-local-value 'nrepl-wait-for-port
on-connection-buffer)
(process-live-p proc))
(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-buffer-name on-connection-buffer-name))
(nrepl--default-endpoint dir port)))
(list :hostname "localhost" :port port :proc-buffer-name nil)))

(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))
(list :hostname "localhost" :port port :proc proc))
(list :hostname tramp-current-host :port port :proc nil)))
(list :hostname "localhost" :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."
(with-parsed-tramp-file-name dir nil
;; 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.
(format-spec
"%s -v -N -L %p:localhost:%p %u'%h'"
`((?s . ,ssh)
Expand All @@ -901,17 +878,16 @@ Return a plist with :hostname, :port and :proc keys."
"Return a filter function for waiting on PORT to appear in output."
(let ((port-string (format "LOCALHOST:%s" port)))
(lambda (proc string)
(when (string-match port-string string)
(process-put proc :waiting-for-port nil))
(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))))))
(if moving (goto-char (process-mark proc)))))))))


;;; Utilities
Expand Down Expand Up @@ -1091,19 +1067,19 @@ Moves CONNECITON-BUFFER to the front of `nrepl-connection-list'."
(nrepl--connections-refresh))
(message "Not in an nREPL REPL buffer.")))

(defun nrepl--close-connection-buffer (connection-buffer)
"Closes CONNECTION-BUFFER, removing it from `nrepl-connection-list'.
(defun nrepl--close-connection-buffer (conn-buffer)
"Closes CONN-BUFFER, removing it from `nrepl-connection-list'.
Also closes associated REPL and server buffers."
(let ((nrepl-connection-dispatch connection-buffer))
(let ((buffer (get-buffer connection-buffer)))
(let ((nrepl-connection-dispatch conn-buffer))
(let ((buffer (get-buffer conn-buffer)))
(setq nrepl-connection-list
(delq (buffer-name buffer) nrepl-connection-list))
(when (buffer-live-p buffer)
(dolist (buf-name `(,(buffer-local-value 'nrepl-server-buffer buffer)
,(buffer-local-value 'nrepl-on-connection-buffer buffer)
,buffer))
(when buf-name
(cider--close-buffer buf-name)))))))
(dolist (buf `(,(buffer-local-value 'nrepl-server-buffer buffer)
,(buffer-local-value 'nrepl-tunnel-buffer buffer)
,buffer))
(when buf
(cider--close-buffer buf)))))))


;;; Connection Browser
Expand Down

0 comments on commit 017e708

Please sign in to comment.