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