lisp/rlogin.el

   1 ;;; rlogin.el --- remote login interface
   2
   3 ;; Author: Noah Friedman
   4 ;; Maintainer: Noah Friedman <friedman@prep.ai.mit.edu>
   5 ;; Keywords: unix, comm
   6
   7 ;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
   8 ;;
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13 ;;
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18 ;;
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program; if not, write to: The Free Software Foundation,
  21 ;; Inc.; 675 Massachusetts Avenue.; Cambridge, MA 02139, USA.
  22
  23 ;; $Id: rlogin.el,v 1.28 1995/05/12 17:51:12 roland Exp roland $
  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
  39 (require 'comint)
  40 (require 'shell)
  41
  42 (defvar rlogin-program "rlogin"
  43   "*Name of program to invoke rlogin")
  44
  45 (defvar rlogin-explicit-args nil
  46   "*List of arguments to pass to rlogin on the command line.")
  47
  48 (defvar rlogin-mode-hook nil
  49   "*Hooks to run after setting current buffer to rlogin-mode.")
  50
  51 (defvar rlogin-process-connection-type nil
  52   "*If non-`nil', use a pty for the local rlogin process.
  53 If `nil', use a pipe (if pipes are supported on the local system).
  54
  55 Generally it is better not to waste ptys on systems which have a static
  56 number of them.  On the other hand, some implementations of `rlogin' assume
  57 a pty is being used, and errors will result from using a pipe instead.")
  58
  59 (defvar rlogin-directory-tracking-mode 'local
  60   "*Control whether and how to do directory tracking in an rlogin buffer.
  61
  62 nil means don't do directory tracking.
  63
  64 t means do so using an ftp remote file name.
  65
  66 Any other value means do directory tracking using local file names.
  67 This works only if the remote machine and the local one
  68 share the same directories (through NFS).  This is the default.
  69
  70 This variable becomes local to a buffer when set in any fashion for it.
  71
  72 It is better to use the function of the same name to change the behavior of
  73 directory tracking in an rlogin session once it has begun, rather than
  74 simply setting this variable, since the function does the necessary
  75 re-synching of directories.")
  76
  77 (make-variable-buffer-local 'rlogin-directory-tracking-mode)
  78
  79 (defvar rlogin-host nil
  80   "*The name of the remote host.  This variable is buffer-local.")
  81
  82 (defvar rlogin-remote-user nil
  83   "*The username used on the remote host.
  84 This variable is buffer-local and defaults to your local user name.
  85 If rlogin is invoked with the `-l' option to specify the remote username,
  86 this variable is set from that.")
  87
  88 ;; Initialize rlogin mode map.
  89 (defvar rlogin-mode-map '())
  90 (cond
  91  ((null rlogin-mode-map)
  92   (setq rlogin-mode-map (if (consp shell-mode-map)
  93                             (cons 'keymap shell-mode-map)
  94                           (copy-keymap shell-mode-map)))
  95   (define-key rlogin-mode-map "\C-c\C-c" 'rlogin-send-Ctrl-C)
  96   (define-key rlogin-mode-map "\C-c\C-d" 'rlogin-send-Ctrl-D)
  97   (define-key rlogin-mode-map "\C-c\C-z" 'rlogin-send-Ctrl-Z)
  98   (define-key rlogin-mode-map "\C-c\C-\\" 'rlogin-send-Ctrl-backslash)
  99   (define-key rlogin-mode-map "\C-d" 'rlogin-delchar-or-send-Ctrl-D)
 100   (define-key rlogin-mode-map "\C-i" 'rlogin-tab-or-complete)))
 101
 102 \f
 103 ;;;###autoload (add-hook 'same-window-regexps "^\\*rlogin-.*\\*\\(\\|<[0-9]+>\\)")
 104
 105 (defvar rlogin-history nil)
 106
 107 ;;;###autoload
 108 (defun rlogin (input-args &optional buffer)
 109   "Open a network login connection to HOST via the `rlogin' program.
 110 Input is sent line-at-a-time to the remote connection.
 111
 112 Communication with the remote host is recorded in a buffer `*rlogin-HOST*'
 113 \(or `*rlogin-USER@HOST*' if the remote username differs\).
 114 If a prefix argument is given and the buffer `*rlogin-HOST*' already exists,
 115 a new buffer with a different connection will be made.
 116
 117 When called from a program, if the optional second argument is a string or
 118 buffer, it names the buffer to use.
 119
 120 The variable `rlogin-program' contains the name of the actual program to
 121 run.  It can be a relative or absolute path.
 122
 123 The variable `rlogin-explicit-args' is a list of arguments to give to
 124 the rlogin when starting.  They are added after any arguments given in
 125 INPUT-ARGS.
 126
 127 If the default value of `rlogin-directory-tracking-mode' is t, then the
 128 default directory in that buffer is set to a remote (FTP) file name to
 129 access your home directory on the remote machine.  Occasionally this causes
 130 an error, if you cannot access the home directory on that machine.  This
 131 error is harmless as long as you don't try to use that default directory.
 132
 133 If `rlogin-directory-tracking-mode' is neither t nor nil, then the default
 134 directory is initially set up to your (local) home directory.
 135 This is useful if the remote machine and your local machine
 136 share the same files via NFS.  This is the default.
 137
 138 If you wish to change directory tracking styles during a session, use the
 139 function `rlogin-directory-tracking-mode' rather than simply setting the
 140 variable."
 141   (interactive (list
 142                 (read-from-minibuffer "rlogin arguments (hostname first): "
 143                                       nil nil nil 'rlogin-history)
 144                 current-prefix-arg))
 145
 146   (let* ((process-connection-type rlogin-process-connection-type)
 147          (args (if rlogin-explicit-args
 148                    (append (rlogin-parse-words input-args)
 149                            rlogin-explicit-args)
 150                  (rlogin-parse-words input-args)))
 151          (host (car args))
 152          (user (or (car (cdr (member "-l" args)))
 153                    (user-login-name)))
 154          (buffer-name (if (string= user (user-login-name))
 155                           (format "*rlogin-%s*" host)
 156                         (format "*rlogin-%s@%s*" user host)))
 157          proc)
 158
 159     (cond ((null buffer))
 160           ((or (stringp buffer) (bufferp buffer))
 161            (setq buffer-name buffer))
 162           ((numberp buffer)
 163            (setq buffer-name (format "%s<%d>" buffer-name buffer)))
 164           (t
 165            (setq buffer-name (generate-new-buffer-name buffer-name))))
 166
 167     (pop-to-buffer buffer-name)
 168     (cond
 169      ((comint-check-proc buffer-name))
 170      (t
 171       (comint-exec (current-buffer) buffer-name rlogin-program nil args)
 172       (setq proc (get-process buffer-name))
 173       ;; Set process-mark to point-max in case there is text in the
 174       ;; buffer from a previous exited process.
 175       (set-marker (process-mark proc) (point-max))
 176       (rlogin-mode)
 177
 178       ;; comint-output-filter-functions is just like a hook, except that the
 179       ;; functions in that list are passed arguments.  add-hook serves well
 180       ;; enough for modifying it.
 181       (add-hook 'comint-output-filter-functions 'rlogin-carriage-filter)
 182
 183       (make-local-variable 'rlogin-host)
 184       (setq rlogin-host host)
 185       (make-local-variable 'rlogin-remote-user)
 186       (setq rlogin-remote-user user)
 187
 188       (cond
 189        ((eq rlogin-directory-tracking-mode t)
 190         ;; Do this here, rather than calling the tracking mode function, to
 191         ;; avoid a gratuitous resync check; the default should be the
 192         ;; user's home directory, be it local or remote.
 193         (setq comint-file-name-prefix
 194               (concat "/" rlogin-remote-user "@" rlogin-host ":"))
 195         (cd-absolute comint-file-name-prefix))
 196        ((null rlogin-directory-tracking-mode))
 197        (t
 198         (cd-absolute (concat comint-file-name-prefix "~/"))))))))
 199
 200 (defun rlogin-mode ()
 201   "Set major-mode for rlogin sessions.
 202 If `rlogin-mode-hook' is set, run it."
 203   (interactive)
 204   (kill-all-local-variables)
 205   (shell-mode)
 206   (setq major-mode 'rlogin-mode)
 207   (setq mode-name "rlogin")
 208   (use-local-map rlogin-mode-map)
 209   (setq shell-dirtrackp rlogin-directory-tracking-mode)
 210   (make-local-variable 'comint-file-name-prefix)
 211   (run-hooks 'rlogin-mode-hook))
 212
 213 (defun rlogin-directory-tracking-mode (&optional prefix)
 214   "Do remote or local directory tracking, or disable entirely.
 215
 216 If called with no prefix argument or a unspecified prefix argument (just
 217 ``\\[universal-argument]'' with no number) do remote directory tracking via
 218 ange-ftp.  If called as a function, give it no argument.
 219
 220 If called with a negative prefix argument, disable directory tracking
 221 entirely.
 222
 223 If called with a positive, numeric prefix argument, e.g.
 224 ``\\[universal-argument] 1 M-x rlogin-directory-tracking-mode\'',
 225 then do directory tracking but assume the remote filesystem is the same as
 226 the local system.  This only works in general if the remote machine and the
 227 local one share the same directories (through NFS)."
 228   (interactive "P")
 229   (cond
 230    ((or (null prefix)
 231         (consp prefix))
 232     (setq rlogin-directory-tracking-mode t)
 233     (setq shell-dirtrackp t)
 234     (setq comint-file-name-prefix
 235           (concat "/" rlogin-remote-user "@" rlogin-host ":")))
 236    ((< prefix 0)
 237     (setq rlogin-directory-tracking-mode nil)
 238     (setq shell-dirtrackp nil))
 239    (t
 240     (setq rlogin-directory-tracking-mode 'local)
 241     (setq comint-file-name-prefix "")
 242     (setq shell-dirtrackp t)))
 243   (cond
 244    (shell-dirtrackp
 245     (let* ((proc (get-buffer-process (current-buffer)))
 246            (proc-mark (process-mark proc))
 247            (current-input (buffer-substring proc-mark (point-max)))
 248            (orig-point (point))
 249            (offset (and (>= orig-point proc-mark)
 250                         (- (point-max) orig-point))))
 251       (unwind-protect
 252           (progn
 253             (delete-region proc-mark (point-max))
 254             (goto-char (point-max))
 255             (shell-resync-dirs))
 256         (goto-char proc-mark)
 257         (insert current-input)
 258         (if offset
 259             (goto-char (- (point-max) offset))
 260           (goto-char orig-point)))))))
 261
 262 \f
 263 ;; Parse a line into its constituent parts (words separated by
 264 ;; whitespace).  Return a list of the words.
 265 (defun rlogin-parse-words (line)
 266   (let ((list nil)
 267         (posn 0)
 268         (match-data (match-data)))
 269     (while (string-match "[^ \t\n]+" line posn)
 270       (setq list (cons (substring line (match-beginning 0) (match-end 0))
 271                        list))
 272       (setq posn (match-end 0)))
 273     (store-match-data (match-data))
 274     (nreverse list)))
 275
 276 (defun rlogin-carriage-filter (string)
 277   (let* ((point-marker (point-marker))
 278          (end (process-mark (get-buffer-process (current-buffer))))
 279          (beg (or (and (boundp 'comint-last-output-start)
 280                        comint-last-output-start)
 281                   (- end (length string)))))
 282     (goto-char beg)
 283     (while (search-forward "\C-m" end t)
 284       (delete-char -1))
 285     (goto-char point-marker)))
 286
 287 (defun rlogin-send-Ctrl-C ()
 288   (interactive)
 289   (send-string nil "\C-c"))
 290
 291 (defun rlogin-send-Ctrl-D ()
 292   (interactive)
 293   (send-string nil "\C-d"))
 294
 295 (defun rlogin-send-Ctrl-Z ()
 296   (interactive)
 297   (send-string nil "\C-z"))
 298
 299 (defun rlogin-send-Ctrl-backslash ()
 300   (interactive)
 301   (send-string nil "\C-\\"))
 302
 303 (defun rlogin-delchar-or-send-Ctrl-D (arg)
 304   "\
 305 Delete ARG characters forward, or send a C-d to process if at end of buffer."
 306   (interactive "p")
 307   (if (eobp)
 308       (rlogin-send-Ctrl-D)
 309     (delete-char arg)))
 310
 311 (defun rlogin-tab-or-complete ()
 312   "Complete file name if doing directory tracking, or just insert TAB."
 313   (interactive)
 314   (if rlogin-directory-tracking-mode
 315       (comint-dynamic-complete)
 316     (insert "\C-i")))
 317
 318 ;;; rlogin.el ends here