Ian Eure
·
2012-09-04
ssh.el
1;;; ssh.el --- Support for remote logins using ssh.
2
3;; Copyright (C) 1996, 97, 98, 2001, Noah S. Friedman
4;; Copyright (C) 2010-2012, Ian Eure
5
6;; Author: Noah Friedman <friedman@splode.com>
7;; Maintainer: Ian Eure <ian.eure@gmail.com>
8;; Maintainer: friedman@splode.com
9;; Version: 1.2
10;; Keywords: unix, comm
11;; Created: 1996-07-03
12
13;; This program is free software; you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation; either version 2, or (at your option)
16;; any later version.
17;;
18;; This program is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22;;
23;; You should have received a copy of the GNU General Public License
24;; along with this program; if not, you can either send email to this
25;; program's maintainer or write to: The Free Software Foundation,
26;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
27
28;;; Commentary:
29
30;; Support for remote logins using `ssh'.
31;; This program is layered on top of shell.el; the code here only accounts
32;; for the variations needed to handle a remote process, e.g. directory
33;; tracking and the sending of some special characters.
34
35;; If you wish for ssh mode to prompt you in the minibuffer for
36;; passwords when a password prompt appears, just enter m-x send-invisible
37;; and type in your line, or add `comint-watch-for-password-prompt' to
38;; `comint-output-filter-functions'.
39
40;;; Code:
41
42(require 'comint)
43(require 'shell)
44
45(defgroup ssh nil
46 "Secure remote login interface"
47 :group 'processes
48 :group 'unix)
49
50(defcustom ssh-program "ssh"
51 "*Name of program to invoke ssh"
52 :type 'string
53 :group 'ssh)
54
55(defcustom ssh-explicit-args '()
56 "*List of arguments to pass to ssh on the command line."
57 :type '(repeat (string :tag "Argument"))
58 :group 'ssh)
59
60(defcustom ssh-mode-hook nil
61 "*Hooks to run after setting current buffer to ssh-mode."
62 :type 'hook
63 :group 'ssh)
64
65(defcustom ssh-process-connection-type t
66 "*If non-`nil', use a pty for the local ssh process.
67If `nil', use a pipe (if pipes are supported on the local system).
68
69Generally it is better not to waste ptys on systems which have a static
70number of them. However, ssh won't allocate a pty on the remote host
71unless one is used locally as well."
72 :type '(choice (const :tag "ptys" t)
73 (const :tag "pipes" nil))
74 :group 'ssh)
75
76(defcustom ssh-directory-tracking-mode 'local
77 "*Control whether and how to do directory tracking in an ssh buffer.
78
79nil means don't do directory tracking.
80
81t means do so using an ftp remote file name.
82
83Any other value means do directory tracking using local file names.
84This works only if the remote machine and the local one
85share the same directories (through NFS). This is the default.
86
87This variable becomes local to a buffer when set in any fashion for it.
88
89It is better to use the function of the same name to change the behavior of
90directory tracking in an ssh session once it has begun, rather than
91simply setting this variable, since the function does the necessary
92re-synching of directories."
93 :type '(choice (const :tag "off" nil)
94 (const :tag "ftp" t)
95 (const :tag "local" local))
96 :group 'ssh)
97
98(make-variable-buffer-local 'ssh-directory-tracking-mode)
99
100(defcustom ssh-x-display-follow-current-frame t
101 "*Control X display used by ssh for X tunneling.
102If non-nil and ssh is configured to enable remote X display forwarding,
103the display of the current emacs frame will be used rather than the display
104to which the emacs process was originally launched. \(These may be
105different if currently using a remote frame.\)"
106 :type 'boolean
107 :group 'ssh)
108
109(defcustom ssh-host nil
110 "*The name of the remote host. This variable is buffer-local."
111 :type '(choice (const nil) string)
112 :group 'ssh)
113
114(defcustom ssh-remote-user nil
115 "*The username used on the remote host.
116This variable is buffer-local and defaults to your local user name.
117If ssh is invoked with the `-l' option to specify the remote username,
118this variable is set from that."
119 :type '(choice (const nil) string)
120 :group 'ssh)
121
122;; Initialize ssh mode map.
123(defvar ssh-mode-map '())
124(cond
125 ((null ssh-mode-map)
126 (setq ssh-mode-map (if (consp shell-mode-map)
127 (cons 'keymap shell-mode-map)
128 (copy-keymap shell-mode-map)))
129 (define-key ssh-mode-map "\C-c\C-c" 'ssh-send-Ctrl-C)
130 (define-key ssh-mode-map "\C-c\C-d" 'ssh-send-Ctrl-D)
131 (define-key ssh-mode-map "\C-c\C-z" 'ssh-send-Ctrl-Z)
132 (define-key ssh-mode-map "\C-c\C-\\" 'ssh-send-Ctrl-backslash)
133 (define-key ssh-mode-map "\C-d" 'ssh-delchar-or-send-Ctrl-D)
134 (define-key ssh-mode-map "\C-i" 'ssh-tab-or-complete)))
135
136
137;;;###autoload (add-hook 'same-window-regexps "^\\*ssh-.*\\*\\(\\|<[0-9]+>\\)")
138
139(defvar ssh-history nil)
140
141;;;###
142(defun ssh-hostname-at-point ()
143 (let ((hostname (thing-at-point 'url)))
144 (and hostname (substring-no-properties hostname 7))))
145
146;;;###autoload
147(defun ssh (input-args &optional buffer)
148 "Open a network login connection via `ssh' with args INPUT-ARGS.
149INPUT-ARGS should start with a host name; it may also contain
150other arguments for `ssh'.
151
152Input is sent line-at-a-time to the remote connection.
153
154Communication with the remote host is recorded in a buffer `*ssh-HOST*'
155\(or `*ssh-USER@HOST*' if the remote username differs\).
156If a prefix argument is given and the buffer `*ssh-HOST*' already exists,
157a new buffer with a different connection will be made.
158
159When called from a program, if the optional second argument BUFFER is
160a string or buffer, it specifies the buffer to use.
161
162The variable `ssh-program' contains the name of the actual program to
163run. It can be a relative or absolute path.
164
165The variable `ssh-explicit-args' is a list of arguments to give to
166the ssh when starting. They are prepended to any arguments given in
167INPUT-ARGS.
168
169If the default value of `ssh-directory-tracking-mode' is t, then the
170default directory in that buffer is set to a remote (FTP) file name to
171access your home directory on the remote machine. Occasionally this causes
172an error, if you cannot access the home directory on that machine. This
173error is harmless as long as you don't try to use that default directory.
174
175If `ssh-directory-tracking-mode' is neither t nor nil, then the default
176directory is initially set up to your (local) home directory.
177This is useful if the remote machine and your local machine
178share the same files via NFS. This is the default.
179
180If you wish to change directory tracking styles during a session, use the
181function `ssh-directory-tracking-mode' rather than simply setting the
182variable.
183
184The variable `ssh-x-display-follow-current-frame' can be used to specify
185how ssh X display tunelling interacts with frames on remote displays."
186 (interactive (list
187 (read-from-minibuffer "ssh arguments (hostname first): "
188 (ssh-hostname-at-point)
189 nil nil 'ssh-history)
190 current-prefix-arg))
191
192 (let* ((process-connection-type ssh-process-connection-type)
193 (args (ssh-parse-words input-args))
194 (host-parts (split-string (car args) "@"))
195 (host (car (last host-parts)))
196 (user (or (cadr (member "-l" args))
197 (if (= 2 (length host-parts)) (car host-parts))
198 (user-login-name)))
199 (buffer-name (if (string= user (user-login-name))
200 (format "*ssh %s*" host)
201 (format "*ssh %s@%s*" user host)))
202 proc)
203
204 (and ssh-explicit-args
205 (setq args (append ssh-explicit-args args)))
206
207 (cond ((null buffer))
208 ((stringp buffer)
209 (setq buffer-name buffer))
210 ((bufferp buffer)
211 (setq buffer-name (buffer-name buffer)))
212 ((numberp buffer)
213 (setq buffer-name (format "%s<%d>" buffer-name buffer)))
214 (t
215 (setq buffer-name (generate-new-buffer-name buffer-name))))
216
217 (setq buffer (get-buffer-create buffer-name))
218 (pop-to-buffer buffer-name)
219
220 (cond
221 ((comint-check-proc buffer-name))
222 (t
223 (ssh-with-check-display-override
224 #'(lambda ()
225 (comint-exec buffer buffer-name ssh-program nil args)))
226 (setq proc (get-buffer-process buffer))
227 ;; Set process-mark to point-max in case there is text in the
228 ;; buffer from a previous exited process.
229 (set-marker (process-mark proc) (point-max))
230
231 ;; comint-output-filter-functions is treated like a hook: it is
232 ;; processed via run-hooks or run-hooks-with-args in later versions
233 ;; of emacs.
234 ;; comint-output-filter-functions should already have a
235 ;; permanent-local property, at least in emacs 19.27 or later.
236 (cond
237 ((fboundp 'make-local-hook)
238 (make-local-hook 'comint-output-filter-functions)
239 (add-hook 'comint-output-filter-functions 'ssh-carriage-filter nil t))
240 (t
241 (make-local-variable 'comint-output-filter-functions)
242 (add-hook 'comint-output-filter-functions 'ssh-carriage-filter)))
243
244 (ssh-mode)
245
246 (make-local-variable 'ssh-host)
247 (setq ssh-host host)
248 (make-local-variable 'ssh-remote-user)
249 (setq ssh-remote-user user)
250
251 (condition-case ()
252 (cond ((eq ssh-directory-tracking-mode t)
253 ;; Do this here, rather than calling the tracking mode
254 ;; function, to avoid a gratuitous resync check; the default
255 ;; should be the user's home directory, be it local or remote.
256 (setq comint-file-name-prefix
257 (concat "/" ssh-remote-user "@" ssh-host ":"))
258 (cd-absolute comint-file-name-prefix))
259 ((null ssh-directory-tracking-mode))
260 (t
261 (cd-absolute (concat comint-file-name-prefix "~/"))))
262 (error nil)))))
263 buffer)
264
265(put 'ssh-mode 'mode-class 'special)
266
267(defun ssh-mode ()
268 "Set major-mode for ssh sessions.
269If `ssh-mode-hook' is set, run it."
270 (interactive)
271 (kill-all-local-variables)
272 (shell-mode)
273 (setq major-mode 'ssh-mode)
274 (setq mode-name "ssh")
275 (use-local-map ssh-mode-map)
276 (setq shell-dirtrackp ssh-directory-tracking-mode)
277 (make-local-variable 'comint-file-name-prefix)
278 (run-hooks 'ssh-mode-hook))
279
280(defun ssh-directory-tracking-mode (&optional prefix)
281 "Do remote or local directory tracking, or disable entirely.
282
283If called with no prefix argument or a unspecified prefix argument (just
284``\\[universal-argument]'' with no number) do remote directory tracking via
285ange-ftp. If called as a function, give it no argument.
286
287If called with a negative prefix argument, disable directory tracking
288entirely.
289
290If called with a positive, numeric prefix argument, e.g.
291``\\[universal-argument] 1 M-x ssh-directory-tracking-mode\'',
292then do directory tracking but assume the remote filesystem is the same as
293the local system. This only works in general if the remote machine and the
294local one share the same directories (through NFS)."
295 (interactive "P")
296 (cond
297 ((or (null prefix)
298 (consp prefix))
299 (setq ssh-directory-tracking-mode t)
300 (setq shell-dirtrackp t)
301 (setq comint-file-name-prefix
302 (concat "/" ssh-remote-user "@" ssh-host ":")))
303 ((< prefix 0)
304 (setq ssh-directory-tracking-mode nil)
305 (setq shell-dirtrackp nil))
306 (t
307 (setq ssh-directory-tracking-mode 'local)
308 (setq comint-file-name-prefix "")
309 (setq shell-dirtrackp t)))
310 (cond
311 (shell-dirtrackp
312 (let* ((proc (get-buffer-process (current-buffer)))
313 (proc-mark (process-mark proc))
314 (current-input (buffer-substring proc-mark (point-max)))
315 (orig-point (point))
316 (offset (and (>= orig-point proc-mark)
317 (- (point-max) orig-point))))
318 (unwind-protect
319 (progn
320 (delete-region proc-mark (point-max))
321 (goto-char (point-max))
322 (shell-resync-dirs))
323 (goto-char proc-mark)
324 (insert current-input)
325 (if offset
326 (goto-char (- (point-max) offset))
327 (goto-char orig-point)))))))
328
329;; Check to see if we should override the X display name that the ssh
330;; process will inherit from the environment, which could affect where
331;; remote clients will appear when using X forwarding.
332;;
333;; If ssh-x-display-follow-current-frame is non-nil, this function
334;; overrides the process-environment display for the called function.
335(defun ssh-with-check-display-override (fn)
336 (let (frame-disp emacs-disp)
337 (cond ((and ssh-x-display-follow-current-frame
338 (eq window-system 'x)
339 (setq frame-disp (cdr (assq 'display (frame-parameters))))
340 (setq emacs-disp (getenv "DISPLAY"))
341 ;; setenv is expensive, so don't do all that work if
342 ;; there's no point.
343 (not (string= frame-disp emacs-disp)))
344 ;; Don't shadow process-environment completely because the
345 ;; called function might legitimately want to modify other
346 ;; environment variables permanently; just save and restore
347 ;; original global display value.
348 (unwind-protect
349 (progn
350 (setenv "DISPLAY" frame-disp)
351 (funcall fn))
352 (setenv "DISPLAY" emacs-disp)))
353 (t
354 (funcall fn)))))
355
356
357;; rudimentary parser to split text into tokens. Text in single or double
358;; quotes is considered one token, though nested quoting may not work.
359;;
360;; e.g. (ssh-parse-words "host -o 'Compression no' -X")
361;; => ("host" "-o" "Compression no" "-X")
362;;
363;; Use a temporary buffer to do work because regexps against strings are
364;; not powerful enough to check boundaries without excessive substring
365;; consing (\` only matches at start of string, not at start of search).
366(defun ssh-parse-words (line)
367 (let ((list nil)
368 (text nil)
369 buf)
370 (unwind-protect
371 (save-match-data
372 (save-excursion
373 (setq buf (generate-new-buffer " *ssh-parse-words*"))
374 (set-buffer buf)
375 (insert line)
376 (goto-char (point-min))
377 (while (not (eobp))
378 (setq text nil)
379 (and (looking-at "\\`[ \t]+")
380 (narrow-to-region (match-end 0) (point-max)))
381 (cond ((looking-at "\\`\\(['\"]\\)\\([^\\1]+\\)\\1")
382 (setq text (buffer-substring (match-beginning 2)
383 (match-end 2))))
384 ((looking-at "\\`[^ \t]+")
385 (setq text (buffer-substring (point-min) (match-end 0)))))
386 (narrow-to-region (match-end 0) (point-max))
387 (and text (setq list (cons text list))))))
388 (kill-buffer buf))
389 (nreverse list)))
390
391(defun ssh-carriage-filter (string)
392 (let* ((point-marker (point-marker))
393 (end (process-mark (get-buffer-process (current-buffer))))
394 (beg (or (and (boundp 'comint-last-output-start)
395 comint-last-output-start)
396 (- end (length string)))))
397 (goto-char beg)
398 (while (search-forward "\C-m" end t)
399 (delete-char -1))
400 (goto-char point-marker)))
401
402(defun ssh-send-Ctrl-C ()
403 (interactive)
404 (process-send-string nil "\C-c"))
405
406(defun ssh-send-Ctrl-D ()
407 (interactive)
408 (process-send-string nil "\C-d"))
409
410(defun ssh-send-Ctrl-Z ()
411 (interactive)
412 (process-send-string nil "\C-z"))
413
414(defun ssh-send-Ctrl-backslash ()
415 (interactive)
416 (process-send-string nil "\C-\\"))
417
418(defun ssh-delchar-or-send-Ctrl-D (arg)
419 "\
420Delete ARG characters forward, or send a C-d to process if at end of buffer."
421 (interactive "p")
422 (if (eobp)
423 (ssh-send-Ctrl-D)
424 (delete-char arg)))
425
426(defun ssh-tab-or-complete ()
427 "Complete file name if doing directory tracking, or just insert TAB."
428 (interactive)
429 (if ssh-directory-tracking-mode
430 (comint-dynamic-complete)
431 (insert "\C-i")))
432
433(provide 'ssh)
434
435;;; ssh.el ends here