Commit | Line | Data |
---|---|---|
8749abea GM |
1 | ;;; rlogin.el --- remote login interface |
2 | ||
ba318903 | 3 | ;; Copyright (C) 1992-1995, 1997-1998, 2001-2014 Free Software |
ab422c4d | 4 | ;; Foundation, Inc. |
8749abea GM |
5 | |
6 | ;; Author: Noah Friedman | |
7 | ;; Maintainer: Noah Friedman <friedman@splode.com> | |
8 | ;; Keywords: unix, comm | |
9 | ||
8749abea GM |
10 | ;; This file is part of GNU Emacs. |
11 | ||
874a927a | 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
8749abea | 13 | ;; it under the terms of the GNU General Public License as published by |
874a927a GM |
14 | ;; the Free Software Foundation, either version 3 of the License, or |
15 | ;; (at your option) any later version. | |
8749abea GM |
16 | |
17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
874a927a | 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
8749abea GM |
24 | |
25 | ;;; Commentary: | |
26 | ||
27 | ;; Support for remote logins using `rlogin'. | |
28 | ;; This program is layered on top of shell.el; the code here only accounts | |
29 | ;; for the variations needed to handle a remote process, e.g. directory | |
30 | ;; tracking and the sending of some special characters. | |
31 | ||
32 | ;; If you wish for rlogin mode to prompt you in the minibuffer for | |
33 | ;; passwords when a password prompt appears, just enter m-x send-invisible | |
34 | ;; and type in your line, or add `comint-watch-for-password-prompt' to | |
35 | ;; `comint-output-filter-functions'. | |
36 | ||
37 | ;;; Code: | |
38 | ||
ceca95b1 GM |
39 | ;; FIXME? |
40 | ;; Maybe this file should be obsolete. | |
41 | ;; http://lists.gnu.org/archive/html/emacs-devel/2013-02/msg00517.html | |
42 | ;; It only adds rlogin-directory-tracking-mode. Is that useful? | |
43 | ||
8749abea GM |
44 | (require 'comint) |
45 | (require 'shell) | |
46 | ||
47 | (defgroup rlogin nil | |
508334bc | 48 | "Remote login interface." |
8749abea GM |
49 | :group 'processes |
50 | :group 'unix) | |
51 | ||
ceca95b1 GM |
52 | (defcustom rlogin-program "ssh" |
53 | "Name of program to invoke remote login." | |
54 | :version "24.4" ; rlogin -> ssh | |
8749abea GM |
55 | :type 'string |
56 | :group 'rlogin) | |
57 | ||
ceca95b1 GM |
58 | (defcustom rlogin-explicit-args '("-t" "-t") |
59 | "List of arguments to pass to `rlogin-program' on the command line." | |
60 | :version "24.4" ; nil -> -t -t | |
8749abea GM |
61 | :type '(repeat (string :tag "Argument")) |
62 | :group 'rlogin) | |
63 | ||
64 | (defcustom rlogin-mode-hook nil | |
1fc7dabf | 65 | "Hooks to run after setting current buffer to rlogin-mode." |
8749abea GM |
66 | :type 'hook |
67 | :group 'rlogin) | |
68 | ||
69 | (defcustom rlogin-process-connection-type | |
56442f0c GM |
70 | ;; Solaris 2.x `rlogin' will spew a bunch of ioctl error messages if |
71 | ;; stdin isn't a tty. | |
ceca95b1 GM |
72 | (and (string-match "rlogin" rlogin-program) |
73 | (string-match-p "-solaris2" system-configuration) t) | |
1fc7dabf | 74 | "If non-nil, use a pty for the local rlogin process. |
5199cf98 | 75 | If nil, use a pipe (if pipes are supported on the local system). |
8749abea GM |
76 | |
77 | Generally it is better not to waste ptys on systems which have a static | |
78 | number of them. On the other hand, some implementations of `rlogin' assume | |
79 | a pty is being used, and errors will result from using a pipe instead." | |
ceca95b1 | 80 | :set-after '(rlogin-program) |
8749abea GM |
81 | :type '(choice (const :tag "pipes" nil) |
82 | (other :tag "ptys" t)) | |
83 | :group 'rlogin) | |
84 | ||
85 | (defcustom rlogin-directory-tracking-mode 'local | |
1fc7dabf | 86 | "Control whether and how to do directory tracking in an rlogin buffer. |
8749abea GM |
87 | |
88 | nil means don't do directory tracking. | |
89 | ||
90 | t means do so using an ftp remote file name. | |
91 | ||
92 | Any other value means do directory tracking using local file names. | |
93 | This works only if the remote machine and the local one | |
94 | share the same directories (through NFS). This is the default. | |
95 | ||
96 | This variable becomes local to a buffer when set in any fashion for it. | |
97 | ||
98 | It is better to use the function of the same name to change the behavior of | |
99 | directory tracking in an rlogin session once it has begun, rather than | |
100 | simply setting this variable, since the function does the necessary | |
101 | re-synching of directories." | |
102 | :type '(choice (const :tag "off" nil) | |
103 | (const :tag "ftp" t) | |
104 | (other :tag "local" local)) | |
105 | :group 'rlogin) | |
106 | ||
107 | (make-variable-buffer-local 'rlogin-directory-tracking-mode) | |
108 | ||
109 | (defcustom rlogin-host nil | |
ceca95b1 | 110 | "The name of the default remote host. This variable is buffer-local." |
8749abea GM |
111 | :type '(choice (const nil) string) |
112 | :group 'rlogin) | |
113 | ||
114 | (defcustom rlogin-remote-user nil | |
1fc7dabf | 115 | "The username used on the remote host. |
8749abea GM |
116 | This variable is buffer-local and defaults to your local user name. |
117 | If rlogin is invoked with the `-l' option to specify the remote username, | |
118 | this variable is set from that." | |
119 | :type '(choice (const nil) string) | |
120 | :group 'rlogin) | |
121 | ||
56442f0c GM |
122 | (defvar rlogin-mode-map |
123 | (let ((map (if (consp shell-mode-map) | |
124 | (cons 'keymap shell-mode-map) | |
125 | (copy-keymap shell-mode-map)))) | |
d9d1dfef SM |
126 | (define-key map "\C-c\C-c" 'rlogin-send-Ctrl-C) |
127 | (define-key map "\C-c\C-d" 'rlogin-send-Ctrl-D) | |
128 | (define-key map "\C-c\C-z" 'rlogin-send-Ctrl-Z) | |
129 | (define-key map "\C-c\C-\\" 'rlogin-send-Ctrl-backslash) | |
130 | (define-key map "\C-d" 'rlogin-delchar-or-send-Ctrl-D) | |
131 | (define-key map "\C-i" 'rlogin-tab-or-complete) | |
56442f0c GM |
132 | map) |
133 | "Keymap for `rlogin-mode'.") | |
134 | ||
8749abea GM |
135 | |
136 | \f | |
8749abea GM |
137 | (defvar rlogin-history nil) |
138 | ||
139 | ;;;###autoload | |
140 | (defun rlogin (input-args &optional buffer) | |
141 | "Open a network login connection via `rlogin' with args INPUT-ARGS. | |
142 | INPUT-ARGS should start with a host name; it may also contain | |
143 | other arguments for `rlogin'. | |
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 `*rlogin-HOST*' | |
148 | \(or `*rlogin-USER@HOST*' if the remote username differs\). | |
149 | If a prefix argument is given and the buffer `*rlogin-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 `rlogin-program' contains the name of the actual program to | |
156 | run. It can be a relative or absolute path. | |
157 | ||
158 | The variable `rlogin-explicit-args' is a list of arguments to give to | |
159 | the rlogin when starting. They are added after any arguments given in | |
160 | INPUT-ARGS. | |
161 | ||
162 | If the default value of `rlogin-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 `rlogin-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 `rlogin-directory-tracking-mode' rather than simply setting the | |
175 | variable." | |
176 | (interactive (list | |
ceca95b1 GM |
177 | (read-from-minibuffer (format |
178 | "Arguments for `%s' (hostname first): " | |
179 | (file-name-nondirectory rlogin-program)) | |
8749abea GM |
180 | nil nil nil 'rlogin-history) |
181 | current-prefix-arg)) | |
8749abea GM |
182 | (let* ((process-connection-type rlogin-process-connection-type) |
183 | (args (if rlogin-explicit-args | |
19a31306 | 184 | (append (split-string input-args) |
8749abea | 185 | rlogin-explicit-args) |
19a31306 | 186 | (split-string input-args))) |
9a479835 TTN |
187 | (host (let ((tail args)) |
188 | ;; Find first arg that doesn't look like an option. | |
189 | ;; This still loses for args that take values, feh. | |
190 | (while (and tail (= ?- (aref (car tail) 0))) | |
191 | (setq tail (cdr tail))) | |
192 | (car tail))) | |
8749abea GM |
193 | (user (or (car (cdr (member "-l" args))) |
194 | (user-login-name))) | |
195 | (buffer-name (if (string= user (user-login-name)) | |
196 | (format "*rlogin-%s*" host) | |
0fd2d581 | 197 | (format "*rlogin-%s@%s*" user host)))) |
8749abea GM |
198 | (cond ((null buffer)) |
199 | ((stringp buffer) | |
200 | (setq buffer-name buffer)) | |
201 | ((bufferp buffer) | |
202 | (setq buffer-name (buffer-name buffer))) | |
203 | ((numberp buffer) | |
204 | (setq buffer-name (format "%s<%d>" buffer-name buffer))) | |
205 | (t | |
206 | (setq buffer-name (generate-new-buffer-name buffer-name)))) | |
8749abea | 207 | (setq buffer (get-buffer-create buffer-name)) |
37ac18a3 | 208 | (switch-to-buffer buffer-name) |
0fd2d581 | 209 | (unless (comint-check-proc buffer-name) |
8749abea | 210 | (comint-exec buffer buffer-name rlogin-program nil args) |
8749abea | 211 | (rlogin-mode) |
8749abea GM |
212 | (make-local-variable 'rlogin-host) |
213 | (setq rlogin-host host) | |
214 | (make-local-variable 'rlogin-remote-user) | |
215 | (setq rlogin-remote-user user) | |
56442f0c GM |
216 | (ignore-errors |
217 | (cond ((eq rlogin-directory-tracking-mode t) | |
218 | ;; Do this here, rather than calling the tracking mode | |
219 | ;; function, to avoid a gratuitous resync check; the default | |
220 | ;; should be the user's home directory, be it local or remote. | |
221 | (setq comint-file-name-prefix | |
222 | (concat "/" rlogin-remote-user "@" rlogin-host ":")) | |
223 | (cd-absolute comint-file-name-prefix)) | |
224 | ((null rlogin-directory-tracking-mode)) | |
225 | (t | |
226 | (cd-absolute (concat comint-file-name-prefix "~/")))))))) | |
8749abea GM |
227 | |
228 | (put 'rlogin-mode 'mode-class 'special) | |
229 | ||
cf232e4d | 230 | (define-derived-mode rlogin-mode shell-mode "Rlogin" |
8749abea | 231 | (setq shell-dirtrackp rlogin-directory-tracking-mode) |
cf232e4d | 232 | (make-local-variable 'comint-file-name-prefix)) |
8749abea GM |
233 | |
234 | (defun rlogin-directory-tracking-mode (&optional prefix) | |
235 | "Do remote or local directory tracking, or disable entirely. | |
236 | ||
237 | If called with no prefix argument or a unspecified prefix argument (just | |
238 | ``\\[universal-argument]'' with no number) do remote directory tracking via | |
239 | ange-ftp. If called as a function, give it no argument. | |
240 | ||
241 | If called with a negative prefix argument, disable directory tracking | |
242 | entirely. | |
243 | ||
244 | If called with a positive, numeric prefix argument, e.g. | |
245 | ``\\[universal-argument] 1 M-x rlogin-directory-tracking-mode\'', | |
246 | then do directory tracking but assume the remote filesystem is the same as | |
247 | the local system. This only works in general if the remote machine and the | |
365f8d85 | 248 | local one share the same directories (e.g. through NFS)." |
8749abea GM |
249 | (interactive "P") |
250 | (cond | |
251 | ((or (null prefix) | |
252 | (consp prefix)) | |
253 | (setq rlogin-directory-tracking-mode t) | |
254 | (setq shell-dirtrackp t) | |
255 | (setq comint-file-name-prefix | |
256 | (concat "/" rlogin-remote-user "@" rlogin-host ":"))) | |
257 | ((< prefix 0) | |
258 | (setq rlogin-directory-tracking-mode nil) | |
259 | (setq shell-dirtrackp nil)) | |
260 | (t | |
261 | (setq rlogin-directory-tracking-mode 'local) | |
262 | (setq comint-file-name-prefix "") | |
263 | (setq shell-dirtrackp t))) | |
264 | (cond | |
265 | (shell-dirtrackp | |
266 | (let* ((proc (get-buffer-process (current-buffer))) | |
267 | (proc-mark (process-mark proc)) | |
268 | (current-input (buffer-substring proc-mark (point-max))) | |
269 | (orig-point (point)) | |
270 | (offset (and (>= orig-point proc-mark) | |
271 | (- (point-max) orig-point)))) | |
272 | (unwind-protect | |
273 | (progn | |
274 | (delete-region proc-mark (point-max)) | |
275 | (goto-char (point-max)) | |
276 | (shell-resync-dirs)) | |
277 | (goto-char proc-mark) | |
278 | (insert current-input) | |
279 | (if offset | |
280 | (goto-char (- (point-max) offset)) | |
281 | (goto-char orig-point))))))) | |
282 | ||
283 | \f | |
8749abea GM |
284 | (defun rlogin-send-Ctrl-C () |
285 | (interactive) | |
286 | (process-send-string nil "\C-c")) | |
287 | ||
288 | (defun rlogin-send-Ctrl-D () | |
289 | (interactive) | |
290 | (process-send-string nil "\C-d")) | |
291 | ||
292 | (defun rlogin-send-Ctrl-Z () | |
293 | (interactive) | |
294 | (process-send-string nil "\C-z")) | |
295 | ||
296 | (defun rlogin-send-Ctrl-backslash () | |
297 | (interactive) | |
298 | (process-send-string nil "\C-\\")) | |
299 | ||
300 | (defun rlogin-delchar-or-send-Ctrl-D (arg) | |
56442f0c | 301 | "Delete ARG characters forward, or send a C-d to process if at end of buffer." |
8749abea GM |
302 | (interactive "p") |
303 | (if (eobp) | |
304 | (rlogin-send-Ctrl-D) | |
305 | (delete-char arg))) | |
306 | ||
307 | (defun rlogin-tab-or-complete () | |
308 | "Complete file name if doing directory tracking, or just insert TAB." | |
309 | (interactive) | |
310 | (if rlogin-directory-tracking-mode | |
ceca95b1 | 311 | (completion-at-point) |
8749abea GM |
312 | (insert "\C-i"))) |
313 | ||
314 | (provide 'rlogin) | |
315 | ||
316 | ;;; rlogin.el ends here |