├── README.md ├── helm-ssh-tunnels.el └── ssh-tunnels.el /README.md: -------------------------------------------------------------------------------- 1 | # SSH tunnels 2 | 3 | This package lets you run and kill SSH tunnels. To use it: 4 | 5 | - Set the variable `ssh-tunnels-configurations`, e.g.: 6 | 7 | ```emacs-lisp 8 | (setq ssh-tunnels-configurations 9 | '((:name "my local tunnel" 10 | :local-port 1234 11 | :remote-port 3306 12 | :login "me@host") 13 | (:name "my remote tunnel" 14 | :type "-R" 15 | :local-port 1234 16 | :remote-port 3306 17 | :login "me@host") 18 | (:name "my local socket tunnel" 19 | :type "-L" 20 | :local-socket "/tmp/socket" 21 | :remote-socket "/tmp/socket" 22 | :login "me@host"))) 23 | ``` 24 | 25 | - Type `M-x ssh-tunnels RET` 26 | 27 | - You should see the list of tunnels; running tunnels will have 'R' 28 | in their state column 29 | 30 | - To run the tunnel at the current line, type `r` 31 | 32 | - To kill a running tunnel, type `k` 33 | 34 | - You may want to temporarily change a tunnel's local port. To do 35 | that you may provide a prefix argument to the run command, for 36 | example by typing `C-u 1235 r` 37 | 38 | ## Helm, Ido, Ivy 39 | 40 | The package comes with a Helm frontend (`M-x helm-ssh-tunnels`) as 41 | well as `completing-read` frontends, which can be used with Ido or Ivy 42 | (`M-x ssh-tunnels-run-tunnel` and `M-x ssh-tunnels-kill-tunnel`). 43 | 44 | ## Auto-ssh-tunnels-mode 45 | 46 | This package also includes a global minor-mode that automatically 47 | starts SSH tunnels when Emacs's built-in `open-network-stream` 48 | function is used. Before a connection is made to a host and port that 49 | correspond to a tunnel's host and local port, this mode will make sure 50 | that the tunnel is running. 51 | 52 | Use `M-x auto-ssh-tunnels-mode` to enable this global minor-mode. 53 | 54 | # License 55 | 56 | MIT 57 | -------------------------------------------------------------------------------- /helm-ssh-tunnels.el: -------------------------------------------------------------------------------- 1 | ;;; helm-ssh-tunnels.el --- Helm interface for managing SSH tunnels 2 | 3 | ;; Author: death 4 | ;; Version: 1.0 5 | ;; Package-Requires: ((cl-lib "0.5") (emacs "24") (helm "1.9.9")) 6 | ;; Keywords: tools, convenience, helm 7 | ;; URL: http://github.com/death/ssh-tunnels 8 | 9 | ;; This file is not part of GNU Emacs. 10 | 11 | ;; Copyright (c) 2018 death 12 | 13 | ;; Permission is hereby granted, free of charge, to any person 14 | ;; obtaining a copy of this software and associated documentation 15 | ;; files (the "Software"), to deal in the Software without 16 | ;; restriction, including without limitation the rights to use, copy, 17 | ;; modify, merge, publish, distribute, sublicense, and/or sell copies 18 | ;; of the Software, and to permit persons to whom the Software is 19 | ;; furnished to do so, subject to the following conditions: 20 | 21 | ;; The above copyright notice and this permission notice shall be 22 | ;; included in all copies or substantial portions of the Software. 23 | 24 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 25 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 26 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 27 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS 28 | ;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN 29 | ;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 30 | ;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 31 | ;; SOFTWARE. 32 | 33 | ;;; Commentary: 34 | 35 | ;; This package lets you view, run, and kill SSH tunnels using Helm. 36 | ;; To use it, do the following: 37 | ;; 38 | ;; - Configure ssh-tunnels. 39 | ;; 40 | ;; - Type M-x helm-ssh-tunnels RET. 41 | ;; 42 | ;; - You should see the list of tunnels; running tunnels will have 'R' 43 | ;; in their state column. 44 | ;; 45 | ;; - To run the tunnel at the current line, press F2. 46 | ;; 47 | ;; - To kill a running tunnel, press F3. 48 | ;; 49 | ;; - To toggle the tunnel's state (run it if it is inactive or kill it if it is 50 | ;; running), use the default or persistent action. 51 | 52 | ;;; Code: 53 | 54 | (require 'cl-lib) 55 | (require 'helm) 56 | (require 'ssh-tunnels) 57 | 58 | (defun helm-ssh-tunnels--format-tunnel (tunnel) 59 | (ssh-tunnels--validate tunnel) 60 | (format "%s %-20s %-30s %-4s %-34s" 61 | (if (ssh-tunnels--check tunnel) "R" " ") 62 | (ssh-tunnels--pretty-name (ssh-tunnels--property tunnel :name)) 63 | (ssh-tunnels--property tunnel :login) 64 | (ssh-tunnels--property tunnel :type) 65 | (ssh-tunnels--forward-definition tunnel))) 66 | 67 | (defun helm-ssh-tunnels--get-candidates () 68 | (cl-loop for tunnel in ssh-tunnels-configurations 69 | collect (cons (helm-ssh-tunnels--format-tunnel tunnel) tunnel))) 70 | 71 | (defun helm-ssh-tunnels--persistent-action (candidate) 72 | (ssh-tunnels--toggle-state candidate) 73 | (helm-refresh)) 74 | 75 | (defun helm-ssh-tunnels () 76 | "Show helm interface to ssh-tunnels." 77 | (interactive) 78 | (helm 79 | :buffer "*helm-ssh-tunnels*" 80 | :prompt "Tunnel: " 81 | :sources (helm-build-in-buffer-source "SSH tunnels" 82 | :candidates #'helm-ssh-tunnels--get-candidates 83 | :persistent-action #'helm-ssh-tunnels--persistent-action 84 | :action '(("Toggle state" . ssh-tunnels--toggle-state) 85 | ("Run" . ssh-tunnels--run) 86 | ("Kill" . ssh-tunnels--kill))))) 87 | 88 | (provide 'helm-ssh-tunnels) 89 | 90 | ;;; helm-ssh-tunnels.el ends here 91 | -------------------------------------------------------------------------------- /ssh-tunnels.el: -------------------------------------------------------------------------------- 1 | ;;; ssh-tunnels.el --- Manage SSH tunnels 2 | 3 | ;; Author: death 4 | ;; Version: 1.0 5 | ;; Package-Requires: ((cl-lib "0.5") (emacs "24")) 6 | ;; Keywords: tools, convenience 7 | ;; URL: http://github.com/death/ssh-tunnels 8 | 9 | ;; This file is not part of GNU Emacs. 10 | 11 | ;; Copyright (c) 2015 death 12 | 13 | ;; Permission is hereby granted, free of charge, to any person 14 | ;; obtaining a copy of this software and associated documentation 15 | ;; files (the "Software"), to deal in the Software without 16 | ;; restriction, including without limitation the rights to use, copy, 17 | ;; modify, merge, publish, distribute, sublicense, and/or sell copies 18 | ;; of the Software, and to permit persons to whom the Software is 19 | ;; furnished to do so, subject to the following conditions: 20 | 21 | ;; The above copyright notice and this permission notice shall be 22 | ;; included in all copies or substantial portions of the Software. 23 | 24 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 25 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 26 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 27 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS 28 | ;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN 29 | ;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 30 | ;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 31 | ;; SOFTWARE. 32 | 33 | ;;; Commentary: 34 | 35 | ;; This package lets you run and kill SSH tunnels. To use it: 36 | ;; 37 | ;; - Set the variable `ssh-tunnels-configurations', e.g.: 38 | ;; 39 | ;; (setq ssh-tunnels-configurations 40 | ;; '((:name "my local tunnel" 41 | ;; :local-port 1234 42 | ;; :remote-port 3306 43 | ;; :login "me@host") 44 | ;; (:name "my remote tunnel" 45 | ;; :type "-R" 46 | ;; :local-port 1234 47 | ;; :remote-port 3306 48 | ;; :login "me@host") 49 | ;; (:name "my local socket tunnel" 50 | ;; :type "-L" 51 | ;; :local-socket "/tmp/socket" 52 | ;; :remote-socket "/tmp/socket" 53 | ;; :login "me@host"))) 54 | ;; 55 | ;; - Type M-x ssh-tunnels RET 56 | ;; 57 | ;; - You should see the list of tunnels; running tunnels will have 'R' 58 | ;; in their state column 59 | ;; 60 | ;; - To run the tunnel at the current line, type r 61 | ;; 62 | ;; - To kill a running tunnel, type k 63 | ;; 64 | ;; - You may want to temporarily change a tunnel's local port. To do 65 | ;; that you may provide a prefix argument to the run command, for 66 | ;; example by typing C-u 1235 r 67 | 68 | ;;; Code: 69 | 70 | (require 'cl-lib) 71 | (require 'netrc) 72 | (require 'tabulated-list) 73 | 74 | (defgroup ssh-tunnels nil 75 | "View and manipulate SSH tunnels." 76 | :group 'tools 77 | :group 'convenience) 78 | 79 | (defcustom ssh-tunnels-use-header-line t 80 | "If non-nil, use the header line to display ssh-tunnels column titles." 81 | :type 'boolean 82 | :group 'ssh-tunnels) 83 | 84 | (defface ssh-tunnels-name 85 | '((t (:weight bold))) 86 | "Face for ssh tunnel names in the ssh tunnels buffer." 87 | :group 'ssh-tunnels) 88 | 89 | (defcustom ssh-tunnels-name-width 20 90 | "Width of tunnel name column in the ssh tunnels buffer." 91 | :type 'number 92 | :group 'ssh-tunnels) 93 | 94 | (defcustom ssh-tunnels-local-port-width 7 95 | "Width of tunnel local port column in the ssh tunnels buffer." 96 | :type 'number 97 | :group 'ssh-tunnels) 98 | 99 | (defcustom ssh-tunnels-host-width 50 100 | "Width of tunnel host column in the ssh tunnels buffer." 101 | :type 'number 102 | :group 'ssh-tunnels) 103 | 104 | (defcustom ssh-tunnels-remote-port-width 7 105 | "Width of tunnel remote port column in the ssh tunnels buffer." 106 | :type 'number 107 | :group 'ssh-tunnels) 108 | 109 | (defcustom ssh-tunnels-login-width 50 110 | "Width of tunnel login column in the ssh tunnels buffer." 111 | :type 'number 112 | :group 'ssh-tunnels) 113 | 114 | (defcustom ssh-tunnels-program "ssh" 115 | "The name of the SSH program." 116 | :type 'string 117 | :group 'ssh-tunnels) 118 | 119 | (defcustom ssh-tunnels-configurations '() 120 | "A list of SSH tunnel configurations. Each element is a plist 121 | with the following properties: 122 | 123 | :name - The name of the tunnel. 124 | 125 | :type - Tunnel type; defaults to \"-L\" (Local). 126 | May also be \"-R\" or \"-D\" for Remote and Dynamic tunnels. 127 | If set to \"SH\", no port forwarding will be attempted and your ssh 128 | client is responsible for tunnelling (e.g. with ~/.ssh/config), in 129 | this case `:login' must match your ~/.ssh/config entry and `:host', 130 | `:local-port', `:remote-port', `:local-socket', `:remote-socket' 131 | are ignored. 132 | 133 | :login - The SSH login to use. 134 | 135 | :host - The tunneling host; defaults to \"localhost\". 136 | 137 | :local-port - The tunnel's local port; defaults 138 | to the value of `:remote-port'. 139 | 140 | :remote-port - The tunnel's remote port; defaults 141 | to the value of `:local-port'. 142 | 143 | For tunneling sockets, use the properties below, instead of `:local-port' 144 | and/or `:remote-port'. 145 | 146 | :local-socket - The tunnel's local socket; defaults 147 | to the value of `:remote-socket'. 148 | 149 | :remote-socket - The tunnel's remote socket; defaults 150 | to the value of `:local-socket'. 151 | 152 | :group - The tunnel's group (a string); defaults to none (`nil'). 153 | Tunnels belonging to the same group may be started or killed 154 | together (e.g., by `ssh-tunnels-run-group'). 155 | " 156 | :type 'sexp 157 | :group 'ssh-tunnels) 158 | 159 | (defcustom ssh-tunnels-temp-directory "/tmp/" 160 | "The directory where SSH control socket files will reside." 161 | :type 'string 162 | :group 'ssh-tunnels) 163 | 164 | (defvar ssh-tunnels--state-table 165 | (make-hash-table :test 'equal) 166 | "A table to keep tunnel-related state. 167 | 168 | Note that we'll lose this state if the user exits Emacs (rms 169 | forbid...), or it may become irrelevant if 170 | `ssh-tunnels-configurations' changes. 171 | 172 | The table is keyed by tunnel names. The state is the local port 173 | or socket associated with the tunnel.") 174 | 175 | (defvar ssh-tunnels-mode-map 176 | (let ((map (make-sparse-keymap))) 177 | (set-keymap-parent map tabulated-list-mode-map) 178 | (define-key map "q" 'quit-window) 179 | (define-key map "g" 'ssh-tunnels-refresh) 180 | (define-key map "r" 'ssh-tunnels-run) 181 | (define-key map "k" 'ssh-tunnels-kill) 182 | (define-key map "R" 'ssh-tunnels-rerun) 183 | map)) 184 | 185 | (define-derived-mode ssh-tunnels-mode tabulated-list-mode "SSH tunnels" 186 | "Major mode for managing SSH tunnels." 187 | (add-hook 'tabulated-list-revert-hook 'ssh-tunnels-refresh nil t)) 188 | 189 | ;;;###autoload 190 | (defun ssh-tunnels () 191 | "View and manipulate SSH tunnels." 192 | (interactive) 193 | (switch-to-buffer (ssh-tunnels--noselect))) 194 | 195 | (defun ssh-tunnels--noselect () 196 | (let ((buffer (get-buffer-create "*SSH tunnels*"))) 197 | (with-current-buffer buffer 198 | (ssh-tunnels-mode) 199 | (ssh-tunnels-refresh)) 200 | buffer)) 201 | 202 | (defun ssh-tunnels-refresh () 203 | (interactive) 204 | (let ((name-width ssh-tunnels-name-width) 205 | (local-port-width ssh-tunnels-local-port-width) 206 | (host-width ssh-tunnels-host-width) 207 | (remote-port-width ssh-tunnels-remote-port-width) 208 | (login-width ssh-tunnels-login-width)) 209 | (setq tabulated-list-format 210 | (vector `("S" 1 t) 211 | `("Name" ,name-width t) 212 | `("Type" 4 t) 213 | `("LPort" ,local-port-width ssh-tunnels--lport> :right-align t) 214 | `("Host" ,host-width t) 215 | `("RPort" ,remote-port-width ssh-tunnels--rport> :right-align t) 216 | `("Login" ,login-width t)))) 217 | (setq tabulated-list-use-header-line ssh-tunnels-use-header-line) 218 | (let ((entries '())) 219 | (dolist (tunnel ssh-tunnels-configurations) 220 | (let* ((name (ssh-tunnels--property tunnel :name)) 221 | (tunnel-type (ssh-tunnels--property tunnel :type)) 222 | (local-port (ssh-tunnels--property tunnel :local-port)) 223 | (remote-port (ssh-tunnels--property tunnel :remote-port)) 224 | (local-socket (ssh-tunnels--property tunnel :local-socket)) 225 | (remote-socket (ssh-tunnels--property tunnel :remote-socket)) 226 | (host (ssh-tunnels--property tunnel :host)) 227 | (login (ssh-tunnels--property tunnel :login))) 228 | (ssh-tunnels--validate tunnel) 229 | (push (list tunnel 230 | (vector (if (ssh-tunnels--check tunnel) "R" " ") 231 | (ssh-tunnels--pretty-name name) 232 | tunnel-type 233 | (if (numberp local-port) 234 | (number-to-string local-port) 235 | local-socket) 236 | host 237 | (if (numberp remote-port) 238 | (number-to-string remote-port) 239 | remote-socket) 240 | login)) 241 | entries))) 242 | (setq tabulated-list-entries (nreverse entries))) 243 | (tabulated-list-init-header) 244 | (tabulated-list-print t)) 245 | 246 | (defun ssh-tunnels--lport> (entry1 entry2) 247 | (> (string-to-number (aref (cadr entry1) 3)) 248 | (string-to-number (aref (cadr entry2) 3)))) 249 | 250 | (defun ssh-tunnels--rport> (entry1 entry2) 251 | (> (string-to-number (aref (cadr entry1) 5)) 252 | (string-to-number (aref (cadr entry2) 5)))) 253 | 254 | (defun ssh-tunnels--pretty-name (name) 255 | (propertize name 256 | 'font-lock-face 'ssh-tunnels-name 257 | 'mouse-face 'highlight)) 258 | 259 | (defun ssh-tunnels--tunnel (&optional error-if-does-not-exist) 260 | (let ((tunnel (tabulated-list-get-id))) 261 | (cond ((null tunnel) 262 | (if error-if-does-not-exist 263 | (error "No tunnel on this line"))) 264 | (t tunnel)))) 265 | 266 | (defun ssh-tunnels-run (&optional arg) 267 | (interactive "P") 268 | (let ((tunnel (ssh-tunnels--tunnel t))) 269 | (when (numberp arg) 270 | ;; Use an ad-hoc local port instead of the local port or socket 271 | ;; specified in configuration. 272 | (setf tunnel (cl-copy-list tunnel)) 273 | (cl-remf tunnel :local-port) 274 | (cl-remf tunnel :local-socket) 275 | (setf tunnel (cl-list* :local-port arg tunnel))) 276 | (ssh-tunnels--validate tunnel) 277 | (when (not (ssh-tunnels--check tunnel)) 278 | (message "Tunneling...") 279 | (ssh-tunnels--run tunnel) 280 | (let ((name (ssh-tunnels--property tunnel :name)) 281 | (local-port (ssh-tunnels--property tunnel :local-port)) 282 | (local-socket (ssh-tunnels--property tunnel :local-socket))) 283 | (if (numberp local-port) 284 | (message "Tunnel '%s' on port %d" name local-port) 285 | (message "Tunnel '%s' on socket '%s'" name local-socket))))) 286 | (forward-line) 287 | (ssh-tunnels-refresh)) 288 | 289 | (defun ssh-tunnels-kill () 290 | (interactive) 291 | (let ((tunnel (ssh-tunnels--tunnel t))) 292 | (when (ssh-tunnels--check tunnel) 293 | (ssh-tunnels--kill tunnel) 294 | (message "Tunnel '%s' killed" (ssh-tunnels--property tunnel :name)))) 295 | (forward-line) 296 | (ssh-tunnels-refresh)) 297 | 298 | (defun ssh-tunnels-rerun (&optional arg) 299 | (interactive "P") 300 | (ssh-tunnels-kill) 301 | (forward-line -1) 302 | (ssh-tunnels-run arg)) 303 | 304 | (defun ssh-tunnels--property (tunnel key) 305 | (cond ((eq key :host) 306 | (or (cl-getf tunnel :host) "localhost")) 307 | ((eq key :type) 308 | (or (cl-getf tunnel :type) "-L")) 309 | ((eq key :local-port) 310 | (let ((state (gethash (cl-getf tunnel :name) ssh-tunnels--state-table))) 311 | (if (numberp state) 312 | state 313 | (or (cl-getf tunnel :local-port) 314 | (and (null (cl-getf tunnel :local-socket)) 315 | (cl-getf tunnel :remote-port)))))) 316 | ((eq key :remote-port) 317 | (and (null (cl-getf tunnel :remote-socket)) 318 | (or (cl-getf tunnel :remote-port) 319 | (cl-getf tunnel :local-port)))) 320 | ((eq key :local-socket) 321 | (let ((state (gethash (cl-getf tunnel :name) ssh-tunnels--state-table))) 322 | (if (stringp state) 323 | state 324 | (or (cl-getf tunnel :local-socket) 325 | (and (null (cl-getf tunnel :local-port)) 326 | (cl-getf tunnel :remote-socket)))))) 327 | ((eq key :remote-socket) 328 | (and (null (cl-getf tunnel :remote-port)) 329 | (or (cl-getf tunnel :remote-socket) 330 | (cl-getf tunnel :local-socket)))) 331 | (t 332 | (cl-getf tunnel key)))) 333 | 334 | (defun ssh-tunnels--validate (tunnel) 335 | ;; Note that we don't use ssh-tunnels--property to check for 336 | ;; mutually exclusive options, to avoid its default value behavior. 337 | (when (and (cl-getf tunnel :local-port) 338 | (cl-getf tunnel :local-socket)) 339 | (error "Tunnel '%s' has both a `:local-port' and a `:local-socket'" 340 | (ssh-tunnels--property tunnel :name))) 341 | (when (and (cl-getf tunnel :remote-port) 342 | (cl-getf tunnel :remote-socket)) 343 | (error "Tunnel '%s' has both a ':remote-port' and a ':remote-socket'" 344 | (ssh-tunnels--property tunnel :name)))) 345 | 346 | (defun ssh-tunnels--command (tunnel command) 347 | (let* ((name (ssh-tunnels--property tunnel :name)) 348 | (tunnel-type (ssh-tunnels--property tunnel :type)) 349 | (login (ssh-tunnels--property tunnel :login)) 350 | (args 351 | (cond ((eq command :run) 352 | (append (list "-M" "-f" "-N" "-T") 353 | (if (string= tunnel-type "SH") 354 | '() 355 | (list tunnel-type 356 | (ssh-tunnels--forward-definition tunnel))))) 357 | ((eq command :kill) 358 | (list "-O" "exit")) 359 | ((eq command :check) 360 | (list "-O" "check")) 361 | (t (error "Unknown ssh-tunnels command '%s'" command)))) 362 | (default-directory ssh-tunnels-temp-directory)) 363 | (with-temp-buffer 364 | (let ((exit-status 365 | (apply 'call-process ssh-tunnels-program nil t nil 366 | "-S" (shell-quote-argument name) 367 | (append args (list login))))) 368 | (when (and (eq command :run) 369 | (not (eql 0 exit-status))) 370 | (if (numberp exit-status) 371 | (error "Tunnel '%s' could not be created: '%s' (exit status %d)" 372 | name 373 | (buffer-substring-no-properties (point-min) (point-max)) 374 | exit-status) 375 | (error "Tunnel '%s' could not be created: process exited with signal '%s'" 376 | name 377 | exit-status))) 378 | exit-status)))) 379 | 380 | (defun ssh-tunnels--run (tunnel) 381 | (remhash (ssh-tunnels--property tunnel :name) 382 | ssh-tunnels--state-table) 383 | (ssh-tunnels--command tunnel :run) 384 | (puthash (ssh-tunnels--property tunnel :name) 385 | (or (ssh-tunnels--property tunnel :local-port) 386 | (ssh-tunnels--property tunnel :local-socket)) 387 | ssh-tunnels--state-table)) 388 | 389 | (defun ssh-tunnels--kill (tunnel) 390 | (ssh-tunnels--command tunnel :kill) 391 | (remhash (ssh-tunnels--property tunnel :name) 392 | ssh-tunnels--state-table)) 393 | 394 | (defun ssh-tunnels--check (tunnel) 395 | (eql 0 (ssh-tunnels--command tunnel :check))) 396 | 397 | (defun ssh-tunnels--toggle-state (tunnel) 398 | (if (ssh-tunnels--check tunnel) 399 | (ssh-tunnels--kill tunnel) 400 | (ssh-tunnels--run tunnel))) 401 | 402 | (defun ssh-tunnels--forward-definition (tunnel) 403 | (let* ((name (ssh-tunnels--property tunnel :name)) 404 | (tunnel-type (ssh-tunnels--property tunnel :type)) 405 | (local-port (ssh-tunnels--property tunnel :local-port)) 406 | (remote-port (ssh-tunnels--property tunnel :remote-port)) 407 | (local-socket (ssh-tunnels--property tunnel :local-socket)) 408 | (remote-socket (ssh-tunnels--property tunnel :remote-socket)) 409 | (host (ssh-tunnels--property tunnel :host)) 410 | (host 411 | (if (string-match-p (regexp-quote ":") host) 412 | (format "[%s]" host) 413 | host))) 414 | (cond ((string= tunnel-type "-D") 415 | (unless (numberp local-port) 416 | (error "No local port specified for tunnel '%s'" name)) 417 | (format "%s:%s" host local-port)) 418 | ((string= tunnel-type "-R") 419 | (cond 420 | ((and remote-port local-socket) 421 | (format "%s:%s:%s" host remote-port local-socket)) 422 | ((and remote-socket local-socket) 423 | (format "%s:%s" remote-socket local-socket)) 424 | (t (format "%s:%s:%s" 425 | (or remote-port remote-socket) 426 | host 427 | (or local-port local-socket))))) 428 | (t 429 | ;; Default Local port forwarding 430 | (cond 431 | ((and local-port remote-socket) 432 | (format "%s:%s:%s" host local-port remote-socket)) 433 | ((and local-socket remote-socket) 434 | (format "%s:%s" local-socket remote-socket)) 435 | ((and local-socket remote-port) 436 | (format "%s:%s:%s" local-socket host remote-port)) 437 | (t (format "%s:%s:%s" 438 | (or local-port local-socket) 439 | host 440 | (or remote-port remote-socket)))))))) 441 | 442 | ;;; completing-read frontend 443 | 444 | (defun ssh-tunnels--list-tunnel-names () 445 | "Return a list of SSH tunnel names." 446 | (cl-loop for tunnel in ssh-tunnels-configurations 447 | collect (ssh-tunnels--property tunnel :name))) 448 | 449 | (defun ssh-tunnels--read-tunnel-name () 450 | "Read an SSH tunnel name from the minibuffer." 451 | (completing-read "Tunnel: " (ssh-tunnels--list-tunnel-names) nil t)) 452 | 453 | (defun ssh-tunnels--get-tunnel-by-name (tunnel-name) 454 | "Return an SSH tunnel with the supplied name, or NIL if none is 455 | found." 456 | (cl-find tunnel-name ssh-tunnels-configurations 457 | :test #'string= 458 | :key (lambda (tunnel) 459 | (ssh-tunnels--property tunnel :name)))) 460 | 461 | (defun ssh-tunnels-run-tunnel (tunnel-name) 462 | "Start a configured SSH tunnel." 463 | (interactive (list (ssh-tunnels--read-tunnel-name))) 464 | (let ((tunnel (ssh-tunnels--get-tunnel-by-name tunnel-name))) 465 | (when tunnel 466 | (ssh-tunnels--run tunnel)))) 467 | 468 | (defun ssh-tunnels-kill-tunnel (tunnel-name) 469 | "Kill a running SSH tunnel." 470 | (interactive (list (ssh-tunnels--read-tunnel-name))) 471 | (let ((tunnel (ssh-tunnels--get-tunnel-by-name tunnel-name))) 472 | (when tunnel 473 | (ssh-tunnels--kill tunnel)))) 474 | 475 | (defun ssh-tunnels--list-groups () 476 | "Return a list of SSH tunnel groups." 477 | (remove nil 478 | (cl-remove-duplicates 479 | (mapcar (lambda (tunnel) 480 | (ssh-tunnels--property tunnel :group)) 481 | ssh-tunnels-configurations) 482 | :test #'string=))) 483 | 484 | (defun ssh-tunnels--read-group () 485 | "Read an SSH tunnel group from the minibuffer." 486 | (completing-read "Group: " (ssh-tunnels--list-groups) nil t)) 487 | 488 | (defun ssh-tunnels--get-tunnels-by-group (group) 489 | "Return a list of SSH tunnels matching `group'." 490 | (cl-loop for tunnel in ssh-tunnels-configurations 491 | when (string= (ssh-tunnels--property tunnel :group) group) 492 | collect tunnel)) 493 | 494 | (defun ssh-tunnels-run-group (group) 495 | "Start configured SSH tunnels by given group." 496 | (interactive (list (ssh-tunnels--read-group))) 497 | (dolist (tunnel (ssh-tunnels--get-tunnels-by-group group)) 498 | (ssh-tunnels--run tunnel))) 499 | 500 | (defun ssh-tunnels-kill-group (group) 501 | "Kill configured SSH tunnels by given group." 502 | (interactive (list (ssh-tunnels--read-group))) 503 | (dolist (tunnel (ssh-tunnels--get-tunnels-by-group group)) 504 | (ssh-tunnels--kill tunnel))) 505 | 506 | (defun ssh-tunnels-kill-all () 507 | "Kill all SSH configured tunnels." 508 | (interactive) 509 | (dolist (tunnel ssh-tunnels-configurations) 510 | (ssh-tunnels--kill tunnel))) 511 | 512 | ;;; auto-ssh-tunnels mode 513 | 514 | (defun ssh-tunnels--lookup (host service) 515 | "Return an SSH tunnel that matches the supplied HOST and 516 | SERVICE, or NIL if there is no match." 517 | ;; According to OPEN-NETWORK-STREAM documentation, SERVICE may be a 518 | ;; service name, or an integer, or an integer string. If it is an 519 | ;; integer string, we convert it to an integer here. 520 | (when (and (stringp service) 521 | (cl-some #'cl-digit-char-p service) 522 | (cl-every #'cl-digit-char-p service)) 523 | (setq service (string-to-number service))) 524 | (cl-find-if (lambda (tunnel) 525 | (and (not (string= "SH" (ssh-tunnels--property tunnel :type))) 526 | (string= host (ssh-tunnels--property tunnel :host)) 527 | (let ((tunnel-lport (ssh-tunnels--property tunnel :local-port))) 528 | (and (numberp tunnel-lport) 529 | (if (stringp service) 530 | (netrc-port-equal service tunnel-lport) 531 | (= service tunnel-lport)))))) 532 | ssh-tunnels-configurations)) 533 | 534 | (defun open-network-stream@run-ssh-tunnel (name buffer host service &rest parameters) 535 | "Start SSH tunnel, if needed, before connecting to HOST. 536 | 537 | Check whether `ssh-tunnels-configurations' has a tunnel matching 538 | the host and service and, if so, make sure that the tunnel is 539 | running." 540 | (let ((tunnel (ssh-tunnels--lookup host service))) 541 | (when (and tunnel (not (ssh-tunnels--check tunnel))) 542 | (message "Starting tunnel '%s'..." (ssh-tunnels--property tunnel :name)) 543 | (ssh-tunnels--run tunnel)))) 544 | 545 | (define-minor-mode auto-ssh-tunnels-mode "Automatically start SSH tunnels" 546 | :global t 547 | :group 'ssh-tunnels 548 | (if auto-ssh-tunnels-mode 549 | (advice-add 'open-network-stream :before 550 | #'open-network-stream@run-ssh-tunnel) 551 | (advice-remove 'open-network-stream #'open-network-stream@run-ssh-tunnel))) 552 | 553 | (provide 'ssh-tunnels) 554 | 555 | ;;; ssh-tunnels.el ends here 556 | --------------------------------------------------------------------------------