Mercurial > hg > xemacs-beta

comparison lisp/comint/telnet.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 56c54cf7c5b6
children 54cc21c15cbb
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; telnet.el --- run a telnet session from within an Emacs buffer 1 ;;; telnet.el --- run a telnet session from within an Emacs buffer
2 2
3 ;;; Copyright (C) 1985, 1988, 1992, 1994 Free Software Foundation, Inc. 3 ;;; Copyright (C) 1985, 1988, 1992, 1993, 1994 Free Software Foundation, Inc.
4 4
5 ;; Author: William F. Schelter 5 ;; Author: William F. Schelter
6 ;; Keywords: comm, unix 6 ;; Keywords: comm, unix
7 ;; Maintainer: FSF 7 ;; Maintainer: FSF
8 8
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details. 19 ;; General Public License for more details.
20 20
21 ;; You should have received a copy of the GNU General Public License 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 22 ;; along with XEmacs; see the file COPYING. If not, write to the
23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; 02111-1307, USA. 24 ;; Boston, MA 02111-1307, USA.
25 25
26 ;;; Synched up with: FSF 19.34. 26 ;;; Synched up with: FSF 19.30.
27 27
28 ;;; Commentary: 28 ;;; Commentary:
29 29
30 ;; This mode is intended to be used for telnet or rsh to a remode host; 30 ;; This mode is intended to be used for telnet or rsh to a remode host;
31 ;; `telnet' and `rsh' are the two entry points. Multiple telnet or rsh 31 ;; `telnet' and `rsh' are the two entry points. Multiple telnet or rsh
51 ;; needs hacking if it is going to deal with asynchronous output in a sane 51 ;; needs hacking if it is going to deal with asynchronous output in a sane
52 ;; manner 52 ;; manner
53 53
54 (require 'comint) 54 (require 'comint)
55 55
56 (defgroup telnet nil
57 "Telnet/rsh stuff"
58 :group 'comint)
59
60 (defvar telnet-new-line "\r") 56 (defvar telnet-new-line "\r")
61 (defvar telnet-mode-map nil) 57 (defvar telnet-mode-map nil)
58 (make-variable-buffer-local 'telnet-new-line)
62 (defvar telnet-default-prompt-pattern "^[^#$%>\n]*[#$%>] *") 59 (defvar telnet-default-prompt-pattern "^[^#$%>\n]*[#$%>] *")
63 (defvar telnet-prompt-pattern telnet-default-prompt-pattern) 60 (defvar telnet-prompt-pattern telnet-default-prompt-pattern)
64
65 (defvar telnet-replace-c-g nil) 61 (defvar telnet-replace-c-g nil)
66 (make-variable-buffer-local 62 (make-variable-buffer-local 'telnet-replace-c-g)
67 (defvar telnet-remote-echoes t 63 (defvar telnet-remote-echoes t
68 "True if the telnet process will echo input.")) 64 "True if the telnet process will echo input.")
69 (make-variable-buffer-local 65 (make-variable-buffer-local 'telnet-remote-echoes)
70 (defvar telnet-interrupt-string "\C-c" "String sent by C-c.")) 66 (defvar telnet-interrupt-string "\C-c"
67 "String sent by C-c.")
68 (make-variable-buffer-local 'telnet-interrupt-string)
71 69
72 (defvar telnet-count 0 70 (defvar telnet-count 0
73 "Number of output strings read from the telnet process 71 "Number of output strings read from the telnet process
74 while looking for the initial password.") 72 while looking for the initial password.")
75 ;; (make-variable-buffer-local 'telnet-count) 73 (make-variable-buffer-local 'telnet-count)
76 74
77 (defcustom telnet-program "telnet" 75 (defvar telnet-program "telnet"
78 "*Program to run to open a telnet connection." 76 "Program to run to open a telnet connection.")
79 :group 'telnet) 77
80 78 (defvar telnet-initial-count -50
81 (defcustom rsh-eat-password-string nil
82 "Non-nil means rsh will look for a string matching a password prompt."
83 :type 'boolean
84 :group 'telnet)
85
86 (defvar telnet-initial-count -75
87 "Initial value of `telnet-count'. Should be set to the negative of the 79 "Initial value of `telnet-count'. Should be set to the negative of the
88 number of terminal writes telnet will make setting up the host connection.") 80 number of terminal writes telnet will make setting up the host connection.")
89 81
90 (defvar telnet-maximum-count 4 82 (defvar telnet-maximum-count 4
91 "Maximum value `telnet-count' can have. 83 "Maximum value `telnet-count' can have.
100 92
101 (defun telnet-c-z () 93 (defun telnet-c-z ()
102 (interactive) 94 (interactive)
103 (process-send-string nil "\C-z")) 95 (process-send-string nil "\C-z"))
104 96
105 ;; XEmacs change (Keep telnet- prefix)
106 (defun telnet-send-process-next-char () 97 (defun telnet-send-process-next-char ()
107 (interactive) 98 (interactive)
108 (process-send-string nil 99 (process-send-string nil
109 (char-to-string 100 (char-to-string
110 (let ((inhibit-quit t)) 101 (let ((inhibit-quit t))
112 (setq quit-flag nil)))))) 103 (setq quit-flag nil))))))
113 104
114 ; initialization on first load. 105 ; initialization on first load.
115 (if telnet-mode-map 106 (if telnet-mode-map
116 nil 107 nil
117 ;; FSF 108 (progn
118 ;; (setq telnet-mode-map (nconc (make-sparse-keymap) comint-mode-map)) 109 (setq telnet-mode-map (make-sparse-keymap))
119 (setq telnet-mode-map (make-sparse-keymap)) 110 (set-keymap-name telnet-mode-map 'telnet-mode-map)
120 (set-keymap-parents telnet-mode-map (list comint-mode-map)) 111 (set-keymap-parents telnet-mode-map (list comint-mode-map))
121 (define-key telnet-mode-map "\C-m" 'telnet-send-input) 112 (define-key telnet-mode-map "\C-m" 'telnet-send-input)
122 ; (define-key telnet-mode-map "\C-j" 'telnet-send-input) 113 ;;(define-key telnet-mode-map "\C-j" 'telnet-send-input)
123 (define-key telnet-mode-map "\C-c\C-q" 'send-process-next-char) 114 (define-key telnet-mode-map "\C-c\C-q" 'telnet-send-process-next-char)
124 (define-key telnet-mode-map "\C-c\C-c" 'telnet-interrupt-subjob) 115 (define-key telnet-mode-map "\C-c\C-c" 'telnet-interrupt-subjob)
125 (define-key telnet-mode-map "\C-c\C-z" 'telnet-c-z)) 116 (define-key telnet-mode-map "\C-c\C-z" 'telnet-c-z)))
126 117
127 ;;maybe should have a flag for when have found type 118 ;;maybe should have a flag for when have found type
128 (defun telnet-check-software-type-initialize (string) 119 (defun telnet-check-software-type-initialize (string)
129 "Tries to put correct initializations in. Needs work." 120 "Tries to put correct initializations in. Needs work."
130 (let ((case-fold-search t)) 121 (let ((case-fold-search t))
134 ((string-match "tops-20" string) ;;maybe add telnet-replace-c-g 125 ((string-match "tops-20" string) ;;maybe add telnet-replace-c-g
135 (setq telnet-prompt-pattern "[@>] *")) 126 (setq telnet-prompt-pattern "[@>] *"))
136 ((string-match "its" string) 127 ((string-match "its" string)
137 (setq telnet-prompt-pattern "^[^*>\n]*[*>] *")) 128 (setq telnet-prompt-pattern "^[^*>\n]*[*>] *"))
138 ((string-match "explorer" string) ;;explorer telnet needs work 129 ((string-match "explorer" string) ;;explorer telnet needs work
139 (setq telnet-replace-c-g ?\n)))) 130 (setq telnet-replace-c-g ?\n))
131 (t
132 (setq telnet-prompt-pattern telnet-default-prompt-pattern))))
140 (setq comint-prompt-regexp telnet-prompt-pattern)) 133 (setq comint-prompt-regexp telnet-prompt-pattern))
141 134
142 (defun telnet-initial-filter (proc string) 135 (defun telnet-initial-filter (proc string)
143 (let ((case-fold-search t)) 136 ;For reading up to and including password; also will get machine type.
144 ;For reading up to and including password; also will get machine type. 137 (cond ((string-match "No such host" string)
145 (cond ((string-match "No such host" string) 138 (kill-buffer (process-buffer proc))
146 (kill-buffer (process-buffer proc)) 139 (error "No such host."))
147 (error "No such host.")) 140 ((string-match "passw" string)
148 ((string-match "passw" string) 141 (telnet-filter proc string)
142 (let ((password (comint-read-noecho "Password: " t)))
143 (setq telnet-count 0)
144 (process-send-string proc (concat password telnet-new-line))))
145 (t (telnet-check-software-type-initialize string)
149 (telnet-filter proc string) 146 (telnet-filter proc string)
150 (let ((password (comint-read-noecho "Password: " t))) 147 (cond ((> telnet-count telnet-maximum-count)
151 (setq telnet-count 0) 148 ;; (set-process-filter proc 'telnet-filter)
152 (process-send-string proc (concat password telnet-new-line)))) 149 ;; Kludge for shell-fonts -- this is the only mode that
153 (t (telnet-check-software-type-initialize string) 150 ;; actually changes what its process filter is at run time,
154 (telnet-filter proc string) 151 ;; which confuses shell-font. So we special-case that here.
155 (cond ((> telnet-count telnet-maximum-count) 152 ;; #### Danger, knows an internal shell-font variable name.
156 ;; (set-process-filter proc 'telnet-filter) Kludge 153 (let ((old-filter (process-filter proc)))
157 ;; for shell-fonts -- this is the only mode that 154 (if (eq old-filter 'shell-font-process-filter)
158 ;; actually changes what its process filter is at 155 (set (make-local-variable 'shell-font-process-filter)
159 ;; run time, which confuses shell-font. So we 156 'telnet-filter)
160 ;; special-case that here. 157 (set-process-filter proc 'telnet-filter))))
161 ;; #### Danger, knows an internal shell-font variable name. 158 (t (setq telnet-count (1+ telnet-count)))))))
162 (let ((old-filter (process-filter proc)))
163 (if (eq old-filter 'shell-font-process-filter)
164 (set (make-local-variable 'shell-font-process-filter)
165 'telnet-filter)
166 (set-process-filter proc 'telnet-filter))))
167 (t (setq telnet-count (1+ telnet-count))))))))
168 159
169 ;; Identical to comint-simple-send, except that it sends telnet-new-line 160 ;; Identical to comint-simple-send, except that it sends telnet-new-line
170 ;; instead of "\n". 161 ;; instead of "\n".
171 (defun telnet-simple-send (proc string) 162 (defun telnet-simple-send (proc string)
172 (comint-send-string proc string) 163 (comint-send-string proc string)
262 (erase-buffer) 253 (erase-buffer)
263 (process-send-string process (concat "open " host 254 (process-send-string process (concat "open " host
264 (if port (concat " " port) "") 255 (if port (concat " " port) "")
265 "\n")) 256 "\n"))
266 (setq comint-input-sender 'telnet-simple-send) 257 (setq comint-input-sender 'telnet-simple-send)
258 (setq telnet-count telnet-initial-count)
267 ;; run last so that hooks can change things. 259 ;; run last so that hooks can change things.
268 (telnet-mode)))) 260 (telnet-mode))))
269 261
270 (defun telnet-mode () 262 (defun telnet-mode ()
271 "This mode is for using telnet (or rsh) from a buffer to another host. 263 "This mode is for using telnet (or rsh) from a buffer to another host.
280 (comint-mode) 272 (comint-mode)
281 (setq major-mode 'telnet-mode 273 (setq major-mode 'telnet-mode
282 mode-name "Telnet" 274 mode-name "Telnet"
283 comint-prompt-regexp telnet-prompt-pattern) 275 comint-prompt-regexp telnet-prompt-pattern)
284 (use-local-map telnet-mode-map) 276 (use-local-map telnet-mode-map)
285 (set (make-local-variable 'telnet-count) telnet-initial-count)
286 (run-hooks 'telnet-mode-hook)) 277 (run-hooks 'telnet-mode-hook))
287 278
288 ;;;###autoload (add-hook 'same-window-regexps "\\*rsh-[^-]*\\*\\(\\|<[0-9]*>\\)") 279 ;;;###autoload (add-hook 'same-window-regexps "\\*rsh-[^-]*\\*\\(\\|<[0-9]*>\\)")
289 280
290 ;; Berkeley spawn of hell 281 ;; Berkeley spawn of hell
296 See also `\\[telnet]'." 287 See also `\\[telnet]'."
297 (interactive "sOpen rsh connection to host: ") 288 (interactive "sOpen rsh connection to host: ")
298 (require 'shell) 289 (require 'shell)
299 (let ((name (concat "rsh-" host))) 290 (let ((name (concat "rsh-" host)))
300 (pop-to-buffer (make-comint name remote-shell-program nil host)) 291 (pop-to-buffer (make-comint name remote-shell-program nil host))
292 (setq telnet-count telnet-initial-count)
301 ;; 293 ;;
302 ;; SunOS doesn't print "unix" in its rsh login banner, so let's get a 294 ;; SunOS doesn't print "unix" in its rsh login banner, so let's get a
303 ;; reasonable default here. There do exist non-Unix machines which 295 ;; reasonable default here. There do exist non-Unix machines which
304 ;; speak the rsh protocol, but let's hope they print their OS name 296 ;; speak the rsh protocol, but let's hope they print their OS name
305 ;; when one connects. 297 ;; when one connects.
310 ;; because rsh generally doesn't prompt for a password, and gobbling the 302 ;; because rsh generally doesn't prompt for a password, and gobbling the
311 ;; first line that contains "passw" is extremely antisocial. More 303 ;; first line that contains "passw" is extremely antisocial. More
312 ;; antisocial than echoing a password, and more likely than connecting 304 ;; antisocial than echoing a password, and more likely than connecting
313 ;; to a non-Unix rsh host these days... 305 ;; to a non-Unix rsh host these days...
314 ;; 306 ;;
315 ;; I disagree with the above. -sb 307 ;; (set-process-filter (get-process name) 'telnet-initial-filter)
316 ;; 308 (set-process-filter (get-process name) 'telnet-filter)
317 (set-process-filter (get-process name) (if rsh-eat-password-string
318 'telnet-initial-filter
319 'telnet-filter))
320 ;; (set-process-filter (get-process name) 'telnet-filter)
321 ;; run last so that hooks can change things. 309 ;; run last so that hooks can change things.
322 (telnet-mode))) 310 (telnet-mode)))
323 311
324 (provide 'telnet) 312 (provide 'telnet)
325 313