comparison lisp/comint/telnet.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children b82b59fe008d
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; telnet.el --- run a telnet session from within an Emacs buffer
2
3 ;;; Copyright (C) 1985, 1988, 1992, 1993, 1994 Free Software Foundation, Inc.
4
5 ;; Author: William F. Schelter
6 ;; Keywords: comm, unix
7 ;; Maintainer: FSF
8
9 ;; This file is part of XEmacs.
10
11 ;; XEmacs is free software; you can redistribute it and/or modify it
12 ;; under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version.
15
16 ;; XEmacs is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
20
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with XEmacs; see the file COPYING. If not, write to the Free
23 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
24
25 ;;; Synched up with: FSF 19.30.
26
27 ;;; Commentary:
28
29 ;; This mode is intended to be used for telnet or rsh to a remode host;
30 ;; `telnet' and `rsh' are the two entry points. Multiple telnet or rsh
31 ;; sessions are supported.
32 ;;
33 ;; Normally, input is sent to the remote telnet/rsh line-by-line, as you
34 ;; type RET or LFD. C-c C-c sends a C-c to the remote immediately;
35 ;; C-c C-z sends C-z immediately. C-c C-q followed by any character
36 ;; sends that character immediately.
37 ;;
38 ;; All RET characters are filtered out of the output coming back from the
39 ;; remote system. The mode tries to do other useful translations based
40 ;; on what it sees coming back from the other system before the password
41 ;; query. It knows about UNIX, ITS, TOPS-20 and Explorer systems.
42
43 ;;; Code:
44
45 ;; to do fix software types for lispm:
46 ;; to eval current expression. Also to try to send escape keys correctly.
47 ;; essentially we'll want the rubout-handler off.
48
49 ;; filter is simplistic but should be okay for typical shell usage.
50 ;; needs hacking if it is going to deal with asynchronous output in a sane
51 ;; manner
52
53 (require 'comint)
54
55 (defvar telnet-new-line "\r")
56 (defvar telnet-mode-map nil)
57 (make-variable-buffer-local 'telnet-new-line)
58 (defvar telnet-default-prompt-pattern "^[^#$%>\n]*[#$%>] *")
59 (defvar telnet-prompt-pattern telnet-default-prompt-pattern)
60 (defvar telnet-replace-c-g nil)
61 (make-variable-buffer-local 'telnet-replace-c-g)
62 (defvar telnet-remote-echoes t
63 "True if the telnet process will echo input.")
64 (make-variable-buffer-local 'telnet-remote-echoes)
65 (defvar telnet-interrupt-string "\C-c"
66 "String sent by C-c.")
67 (make-variable-buffer-local 'telnet-interrupt-string)
68
69 (defvar telnet-count 0
70 "Number of output strings read from the telnet process
71 while looking for the initial password.")
72 (make-variable-buffer-local 'telnet-count)
73
74 (defvar telnet-program "telnet"
75 "Program to run to open a telnet connection.")
76
77 (defvar telnet-initial-count -50
78 "Initial value of `telnet-count'. Should be set to the negative of the
79 number of terminal writes telnet will make setting up the host connection.")
80
81 (defvar telnet-maximum-count 4
82 "Maximum value `telnet-count' can have.
83 After this many passes, we stop looking for initial setup data.
84 Should be set to the number of terminal writes telnet will make
85 rejecting one login and prompting again for a username and password.")
86
87 (defun telnet-interrupt-subjob ()
88 (interactive)
89 "Interrupt the program running through telnet on the remote host."
90 (process-send-string nil telnet-interrupt-string))
91
92 (defun telnet-c-z ()
93 (interactive)
94 (process-send-string nil "\C-z"))
95
96 (defun telnet-send-process-next-char ()
97 (interactive)
98 (process-send-string nil
99 (char-to-string
100 (let ((inhibit-quit t))
101 (prog1 (read-char)
102 (setq quit-flag nil))))))
103
104 ; initialization on first load.
105 (if telnet-mode-map
106 nil
107 (progn
108 (setq telnet-mode-map (make-sparse-keymap))
109 (set-keymap-name telnet-mode-map 'telnet-mode-map)
110 (set-keymap-parents telnet-mode-map (list comint-mode-map))
111 (define-key telnet-mode-map "\C-m" 'telnet-send-input)
112 ;;(define-key telnet-mode-map "\C-j" 'telnet-send-input)
113 (define-key telnet-mode-map "\C-c\C-q" 'telnet-send-process-next-char)
114 (define-key telnet-mode-map "\C-c\C-c" 'telnet-interrupt-subjob)
115 (define-key telnet-mode-map "\C-c\C-z" 'telnet-c-z)))
116
117 ;;maybe should have a flag for when have found type
118 (defun telnet-check-software-type-initialize (string)
119 "Tries to put correct initializations in. Needs work."
120 (let ((case-fold-search t))
121 (cond ((string-match "unix" string)
122 (setq telnet-prompt-pattern shell-prompt-pattern)
123 (setq telnet-new-line "\n"))
124 ((string-match "tops-20" string) ;;maybe add telnet-replace-c-g
125 (setq telnet-prompt-pattern "[@>] *"))
126 ((string-match "its" string)
127 (setq telnet-prompt-pattern "^[^*>\n]*[*>] *"))
128 ((string-match "explorer" string) ;;explorer telnet needs work
129 (setq telnet-replace-c-g ?\n))
130 (t
131 (setq telnet-prompt-pattern telnet-default-prompt-pattern))))
132 (setq comint-prompt-regexp telnet-prompt-pattern))
133
134 (defun telnet-initial-filter (proc string)
135 ;For reading up to and including password; also will get machine type.
136 (cond ((string-match "No such host" string)
137 (kill-buffer (process-buffer proc))
138 (error "No such host."))
139 ((string-match "passw" string)
140 (telnet-filter proc string)
141 (let ((password (comint-read-noecho "Password: " t)))
142 (setq telnet-count 0)
143 (process-send-string proc (concat password telnet-new-line))))
144 (t (telnet-check-software-type-initialize string)
145 (telnet-filter proc string)
146 (cond ((> telnet-count telnet-maximum-count)
147 ;; (set-process-filter proc 'telnet-filter)
148 ;; Kludge for shell-fonts -- this is the only mode that
149 ;; actually changes what its process filter is at run time,
150 ;; which confuses shell-font. So we special-case that here.
151 ;; #### Danger, knows an internal shell-font variable name.
152 (let ((old-filter (process-filter proc)))
153 (if (eq old-filter 'shell-font-process-filter)
154 (set (make-local-variable 'shell-font-process-filter)
155 'telnet-filter)
156 (set-process-filter proc 'telnet-filter))))
157 (t (setq telnet-count (1+ telnet-count)))))))
158
159 ;; Identical to comint-simple-send, except that it sends telnet-new-line
160 ;; instead of "\n".
161 (defun telnet-simple-send (proc string)
162 (comint-send-string proc string)
163 (comint-send-string proc telnet-new-line))
164
165 (defun telnet-filter (proc string)
166 (save-excursion
167 (set-buffer (process-buffer proc))
168 (save-match-data
169 (let* ((last-insertion (marker-position (process-mark proc)))
170 (delta (- (point) last-insertion))
171 (ie (and comint-last-input-end
172 (marker-position comint-last-input-end)))
173 (w (get-buffer-window (current-buffer)))
174 (ws (and w (window-start w))))
175 (goto-char last-insertion)
176 ;; Insert STRING, omitting all C-m characters.
177 (insert-before-markers string)
178 (set-marker (process-mark proc) (point))
179 ;; the insert-before-markers may have screwed window-start
180 ;; and likely moved comint-last-input-end. This is why the
181 ;; insertion-reaction should be a property of markers, not
182 ;; of the function which does the inserting.
183 (if ws (set-window-start w ws t))
184 (if ie (set-marker comint-last-input-end ie))
185 (while (progn (skip-chars-backward "^\C-m" last-insertion)
186 (> (point) last-insertion))
187 (delete-region (1- (point)) (point)))
188 (goto-char (process-mark proc))
189 (and telnet-replace-c-g
190 (subst-char-in-region last-insertion (point) ?\C-g
191 telnet-replace-c-g t))
192 ;; If point is after the insertion place, move it
193 ;; along with the text.
194 (if (> delta 0)
195 (goto-char (+ (process-mark proc) delta)))))))
196
197 (defun telnet-send-input ()
198 (interactive)
199 (let ((proc (get-buffer-process (current-buffer)))
200 p1 p2)
201 (if (and telnet-remote-echoes
202 (>= (point) (process-mark proc)))
203 (save-excursion
204 (if comint-eol-on-send (end-of-line))
205 (setq p1 (marker-position (process-mark proc))
206 p2 (point))))
207 (prog1
208 (comint-send-input)
209 ;; at this point, comint-send-input has moved the process mark, inserted
210 ;; a newline, and possibly inserted the (echoed) output. If the host is
211 ;; in remote-echo mode, then delete our local copy of the command, and
212 ;; the newline that comint-send-input sent.
213 (if p1
214 (delete-region p1 (1+ p2))))))
215
216 ;;;###autoload (add-hook 'same-window-regexps "\\*telnet-.*\\*\\(\\|<[0-9]+>\\)")
217
218 ;;;###autoload
219 (defun telnet (host &optional port)
220 "Open a network login connection to host named HOST (a string).
221 With a prefix argument, prompts for the port name or number as well.
222 Communication with HOST is recorded in a buffer `*HOST-telnet*'.
223 Normally input is edited in Emacs and sent a line at a time.
224 See also `\\[rsh]'."
225 (interactive (list (read-string "Open telnet connection to host: ")
226 (if current-prefix-arg
227 (read-string "Port name or number: ")
228 nil)))
229 (let* ((comint-delimiter-argument-list '(?\ ?\t))
230 (name (concat "telnet-" (comint-arguments host 0 nil)
231 (if port (concat "/" port) "")))
232 (buffer (get-buffer (concat "*" name "*")))
233 process)
234 (if (and buffer (get-buffer-process buffer))
235 (pop-to-buffer buffer)
236 (pop-to-buffer (make-comint name telnet-program))
237 (setq process (get-buffer-process (current-buffer)))
238 (set-process-filter process 'telnet-initial-filter)
239
240 ;; SunOS and IRIX don't print "unix" in their rsh or telnet
241 ;; login banners, so let's get a reasonable default here.
242 ;; #### This patch from jwz mimics what is done in rsh done
243 ;; below. However, it (along with the one in rsh) mean that
244 ;; telnet-check-software-type-initialize is effectively a
245 ;; wastoid function. Reworking it like it claims to need is
246 ;; probably the better solution but I'm not going to do it.
247 ;; --cet
248 (telnet-check-software-type-initialize "unix")
249
250 ;; Don't send the `open' cmd till telnet is ready for it.
251 (accept-process-output process)
252 (erase-buffer)
253 (process-send-string process (concat "open " host
254 (if port (concat " " port) "")
255 "\n"))
256 (setq comint-input-sender 'telnet-simple-send)
257 (setq telnet-count telnet-initial-count)
258 ;; run last so that hooks can change things.
259 (telnet-mode))))
260
261 (defun telnet-mode ()
262 "This mode is for using telnet (or rsh) from a buffer to another host.
263 It has most of the same commands as comint-mode.
264 There is a variable ``telnet-interrupt-string'' which is the character
265 sent to try to stop execution of a job on the remote host.
266 Data is sent to the remote host when RET is typed.
267
268 \\{telnet-mode-map}
269 "
270 (interactive)
271 (comint-mode)
272 (setq major-mode 'telnet-mode
273 mode-name "Telnet"
274 comint-prompt-regexp telnet-prompt-pattern)
275 (use-local-map telnet-mode-map)
276 (run-hooks 'telnet-mode-hook))
277
278 ;;;###autoload (add-hook 'same-window-regexps "\\*rsh-[^-]*\\*\\(\\|<[0-9]*>\\)")
279
280 ;; Berkeley spawn of hell
281 ;;;###autoload
282 (defun rsh (host)
283 "Open a network login connection to host named HOST (a string).
284 Communication with HOST is recorded in a buffer `*rsh-HOST*'.
285 Normally input is edited in Emacs and sent a line at a time.
286 See also `\\[telnet]'."
287 (interactive "sOpen rsh connection to host: ")
288 (require 'shell)
289 (let ((name (concat "rsh-" host)))
290 (pop-to-buffer (make-comint name remote-shell-program nil host))
291 (setq telnet-count telnet-initial-count)
292 ;;
293 ;; SunOS doesn't print "unix" in its rsh login banner, so let's get a
294 ;; reasonable default here. There do exist non-Unix machines which
295 ;; speak the rsh protocol, but let's hope they print their OS name
296 ;; when one connects.
297 ;;
298 (telnet-check-software-type-initialize "unix")
299 ;;
300 ;; I think we should use telnet-filter here instead of -initial-filter,
301 ;; because rsh generally doesn't prompt for a password, and gobbling the
302 ;; first line that contains "passw" is extremely antisocial. More
303 ;; antisocial than echoing a password, and more likely than connecting
304 ;; to a non-Unix rsh host these days...
305 ;;
306 ;; (set-process-filter (get-process name) 'telnet-initial-filter)
307 (set-process-filter (get-process name) 'telnet-filter)
308 ;; run last so that hooks can change things.
309 (telnet-mode)))
310
311 (provide 'telnet)
312
313 ;;; telnet.el ends here