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$
  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
 104 (defun rlogin (input-args &optional prefix)
 105   "Open a network login connection to HOST via the `rlogin' program.
 106 Input is sent line-at-a-time to the remote connection.
 107
 108 Communication with the remote host is recorded in a buffer *rlogin-HOST*
 109 \(or *rlogin-USER@HOST* if the remote username differs\).
 110 If a prefix argument is given and the buffer *rlogin-HOST* already exists,
 111 a new buffer with a different connection will be made.
 112
 113 The variable `rlogin-program' contains the name of the actual program to
 114 run.  It can be a relative or absolute path.
 115
 116 The variable `rlogin-explicit-args' is a list of arguments to give to
 117 the rlogin when starting.  They are added after any arguments given in
 118 INPUT-ARGS.
 119
 120 If the default value of `rlogin-directory-tracking-mode' is t, then the
 121 default directory in that buffer is set to a remote (FTP) file name to
 122 access your home directory on the remote machine.  Occasionally this causes
 123 an error, if you cannot access the home directory on that machine.  This
 124 error is harmless as long as you don't try to use that default directory.
 125
 126 If `rlogin-directory-tracking-mode' is neither t nor nil, then the default
 127 directory is initially set up to your (local) home directory.
 128 This is useful if the remote machine and your local machine
 129 share the same files via NFS.  This is the default.
 130
 131 If you wish to change directory tracking styles during a session, use the
 132 function `rlogin-directory-tracking-mode' rather than simply setting the
 133 variable."
 134   (interactive (list
 135                 (read-from-minibuffer "rlogin arguments (hostname first): ")
 136                 current-prefix-arg))
 137
 138   (let* ((process-connection-type rlogin-process-connection-type)
 139          (args (if rlogin-explicit-args
 140                    (append (rlogin-parse-words input-args)
 141                            rlogin-explicit-args)
 142                  (rlogin-parse-words input-args)))
 143          (host (car args))
 144          (user (or (car (cdr (member "-l" args)))
 145                    (user-login-name)))
 146          (buffer-name (if (string= user (user-login-name))
 147                           (format "*rlogin-%s*" host)
 148                         (format "*rlogin-%s@%s*" user host)))
 149          proc)
 150
 151     (cond
 152      ((and (null prefix)
 153            (comint-check-proc buffer-name))
 154       (switch-to-buffer buffer-name))
 155      ;; This next case is done all in the predicate (including side effects
 156      ;; like switch-to-buffer) to avoid extra string consing via multiple
 157      ;; concats.
 158      ((and (numberp prefix)
 159            (let ((bufname (concat buffer-name "<" prefix ">")))
 160              (and (comint-check-proc bufname)
 161                   (switch-to-buffer bufname)))))
 162      (t
 163       (cond
 164        ((numberp prefix)
 165         (setq buffer-name (concat buffer-name "<" prefix ">")))
 166        (t
 167         (setq buffer-name (generate-new-buffer-name buffer-name))))
 168       (switch-to-buffer buffer-name)
 169       (comint-exec (current-buffer) buffer-name rlogin-program nil args)
 170       (setq proc (get-process buffer-name))
 171       ;; Set process-mark to point-max in case there is text in the
 172       ;; buffer from a previous exited process.
 173       (set-marker (process-mark proc) (point-max))
 174       (rlogin-mode)
 175
 176       ;; comint-output-filter-functions is just like a hook, except that the
 177       ;; functions in that list are passed arguments.  add-hook serves well
 178       ;; enough for modifying it.
 179       (add-hook 'comint-output-filter-functions 'rlogin-carriage-filter)
 180
 181       (make-local-variable 'rlogin-host)
 182       (setq rlogin-host host)
 183       (make-local-variable 'rlogin-remote-user)
 184       (setq rlogin-remote-user user)
 185
 186       (cond
 187        ((eq rlogin-directory-tracking-mode t)
 188         ;; Do this here, rather than calling the tracking mode function, to
 189         ;; avoid a gratuitous resync check; the default should be the
 190         ;; user's home directory, be it local or remote.
 191         (setq comint-file-name-prefix
 192               (concat "/" rlogin-remote-user "@" rlogin-host ":"))
 193         (cd-absolute comint-file-name-prefix))
 194        ((null rlogin-directory-tracking-mode))
 195        (t
 196         (cd-absolute (concat comint-file-name-prefix "~/"))))))))
 197
 198 (defun rlogin-mode ()
 199   "Set major-mode for rlogin sessions.
 200 If `rlogin-mode-hook' is set, run it."
 201   (interactive)
 202   (kill-all-local-variables)
 203   (shell-mode)
 204   (setq major-mode 'rlogin-mode)
 205   (setq mode-name "rlogin")
 206   (use-local-map rlogin-mode-map)
 207   (setq shell-dirtrackp rlogin-directory-tracking-mode)
 208   (make-local-variable 'comint-file-name-prefix)
 209   (run-hooks 'rlogin-mode-hook))
 210
 211 (defun rlogin-directory-tracking-mode (&optional prefix)
 212   "Do remote or local directory tracking, or disable entirely.
 213
 214 If called with no prefix argument or a unspecified prefix argument (just
 215 ``\\[universal-argument]'' with no number) do remote directory tracking via
 216 ange-ftp.  If called as a function, give it no argument.
 217
 218 If called with a negative prefix argument, disable directory tracking
 219 entirely.
 220
 221 If called with a positive, numeric prefix argument, e.g.
 222 ``\\[universal-argument] 1 M-x rlogin-directory-tracking-mode\'',
 223 then do directory tracking but assume the remote filesystem is the same as
 224 the local system.  This only works in general if the remote machine and the
 225 local one share the same directories (through NFS)."
 226   (interactive "P")
 227   (cond
 228    ((or (null prefix)
 229         (consp prefix))
 230     (setq rlogin-directory-tracking-mode t)
 231     (setq shell-dirtrack-p t)
 232     (setq comint-file-name-prefix
 233           (concat "/" rlogin-remote-user "@" rlogin-host ":")))
 234    ((< prefix 0)
 235     (setq rlogin-directory-tracking-mode nil)
 236     (setq shell-dirtrack-p nil))
 237    (t
 238     (setq rlogin-directory-tracking-mode 'local)
 239     (setq comint-file-name-prefix "")
 240     (setq shell-dirtrack-p t)))
 241   (cond
 242    (shell-dirtrack-p
 243     (let* ((proc (get-buffer-process (current-buffer)))
 244            (proc-mark (process-mark proc))
 245            (current-input (buffer-substring proc-mark (point-max)))
 246            (orig-point (point))
 247            (offset (and (>= orig-point proc-mark)
 248                         (- (point-max) orig-point))))
 249       (unwind-protect
 250           (progn
 251             (delete-region proc-mark (point-max))
 252             (goto-char (point-max))
 253             (shell-resync-dirs))
 254         (goto-char proc-mark)
 255         (insert current-input)
 256         (if offset
 257             (goto-char (- (point-max) offset))
 258           (goto-char orig-point)))))))
 259
 260 \f
 261 ;; Parse a line into its constituent parts (words separated by
 262 ;; whitespace).  Return a list of the words.
 263 (defun rlogin-parse-words (line)
 264   (let ((list nil)
 265         (posn 0)
 266         (match-data (match-data)))
 267     (while (string-match "[^ \t\n]+" line posn)
 268       (setq list (cons (substring line (match-beginning 0) (match-end 0))
 269                        list))
 270       (setq posn (match-end 0)))
 271     (store-match-data (match-data))
 272     (nreverse list)))
 273
 274 (defun rlogin-carriage-filter (&rest ignored)
 275   ;; When this function is called, the buffer will already have been
 276   ;; narrowed to the region containing the most recently-inserted text.
 277   ;; (See `comint-output-filter' in comint.el.)
 278   (let ((point-marker (point-marker)))
 279     (goto-char (point-min))
 280     (while (search-forward "\C-m" (point-max) t)
 281       (delete-char -1))
 282     (goto-char point-marker)))
 283
 284 (defun rlogin-send-Ctrl-C ()
 285   (interactive)
 286   (send-string nil "\C-c"))
 287
 288 (defun rlogin-send-Ctrl-D ()
 289   (interactive)
 290   (send-string nil "\C-d"))
 291
 292 (defun rlogin-send-Ctrl-Z ()
 293   (interactive)
 294   (send-string nil "\C-z"))
 295
 296 (defun rlogin-send-Ctrl-backslash ()
 297   (interactive)
 298   (send-string nil "\C-\\"))
 299
 300 (defun rlogin-delchar-or-send-Ctrl-D (arg)
 301   "\
 302 Delete ARG characters forward, or send a C-d to process if at end of buffer."
 303   (interactive "p")
 304   (if (eobp)
 305       (rlogin-send-Ctrl-D)
 306     (delete-char arg)))
 307
 308 (defun rlogin-tab-or-complete ()
 309   "Complete file name if doing directory tracking, or just insert TAB."
 310   (interactive)
 311   (if rlogin-directory-tracking-mode
 312       (comint-dynamic-complete)
 313     (insert "\C-i")))
 314
 315 ;;; rlogin.el ends here