code.delx.au - gnu-emacs/blob - 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 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 ;;; Commentary:
  24
  25 ;; Support for remote logins using `rlogin'.
  26 ;; $Id$
  27
  28 ;;; Todo:
  29
  30 ;; Make this mode deal with comint-last-input-end properly.
  31
  32 ;;; Code:
  33
  34 (require 'comint)
  35 (require 'shell)
  36
  37 ;;;###autoload
  38 (defvar rlogin-program "rlogin"
  39   "*Name of program to invoke rlogin")
  40
  41 ;;;###autoload
  42 (defvar rlogin-explicit-args nil
  43   "*List of arguments to pass to rlogin on the command line.")
  44
  45 ;;;###autoload
  46 (defvar rlogin-mode-hook nil
  47   "*Hooks to run after setting current buffer to rlogin-mode.")
  48
  49 ;;;###autoload
  50 (defvar rlogin-process-connection-type nil
  51   "*If non-`nil', use a pty for the local rlogin process.
  52 If `nil', use a pipe (if pipes are supported on the local system).
  53
  54 Generally it is better not to waste ptys on systems which have a static
  55 number of them.  On the other hand, some implementations of `rlogin' assume
  56 a pty is being used, and errors will result from using a pipe instead.")
  57
  58 ;;;###autoload
  59 ;(setq rlogin-initially-track-cwd nil)
  60 (defvar rlogin-initially-track-cwd t
  61   "*If non-`nil', do remote directory tracking via ange-ftp right away.
  62 If `nil', you can still enable directory tracking by doing
  63 `M-x dirtrack-toggle'.")
  64
  65 ;; Leave this nil because it makes rlogin-filter a tiny bit faster.  Plus
  66 ;; you can still call rlogin-password by hand.
  67 ;;;###autoload
  68 (defvar rlogin-password-paranoia nil
  69   "*If non-`nil', query user for a password in the minibuffer when a Password: prompt appears.
  70 It's also possible to selectively enter passwords without echoing them in
  71 the minibuffer using the command `rlogin-password' explicitly.")
  72
  73 ;; Initialize rlogin mode map.
  74 ;;;###autoload
  75 (defvar rlogin-mode-map '())
  76 (cond ((not rlogin-mode-map)
  77        (setq rlogin-mode-map (cons 'keymap shell-mode-map))
  78        (define-key rlogin-mode-map "\C-c\C-c" 'rlogin-send-Ctrl-C)
  79        (define-key rlogin-mode-map "\C-c\C-z" 'rlogin-send-Ctrl-Z)
  80        (define-key rlogin-mode-map "\C-c\C-\\" 'rlogin-send-Ctrl-backslash)
  81        (define-key rlogin-mode-map "\C-d" 'rlogin-delchar-or-send-Ctrl-D)))
  82
  83 ;;;###autoload
  84 (defun rlogin (input-args &optional prefix)
  85   "Open a network login connection to HOST via the `rlogin' program.
  86 Input is sent line-at-a-time to the remote connection.
  87
  88 Communication with the remote host is recorded in a buffer *rlogin-HOST*,
  89 where HOST is the first word in the string ARGS.  If a prefix argument is
  90 given and the buffer *rlogin-HOST* already exists, a new buffer with a
  91 different connection will be made.
  92
  93 The variable `rlogin-program' contains the name of the actual program to
  94 run.  It can be a relative or absolute path.
  95
  96 The variable `rlogin-explicit-args' is a list of arguments to give to
  97 the rlogin when starting.  They are added after any arguments given in ARGS."
  98   (interactive (list (read-from-minibuffer "rlogin arguments (hostname first): ")
  99                      current-prefix-arg))
 100   (let* ((process-connection-type rlogin-process-connection-type)
 101          (buffer-name (format "*rlogin-%s*" input-args))
 102          args
 103          proc
 104          (old-match-data (match-data)))
 105     (while (string-match "[ \t]*\\([^ \t]+\\)$" input-args)
 106       (setq args
 107             (cons (substring input-args (match-beginning 1) (match-end 1))
 108                   args)
 109             input-args (substring input-args 0 (match-beginning 0))))
 110     (store-match-data old-match-data)
 111     (setq buffer-name (format "*rlogin-%s*" (car args))
 112           args (append args rlogin-explicit-args))
 113     (and prefix (setq buffer-name
 114                       (buffer-name (generate-new-buffer buffer-name))))
 115     (switch-to-buffer buffer-name)
 116     (or (comint-check-proc buffer-name)
 117         (progn
 118           (comint-mode)
 119           (comint-exec (current-buffer) buffer-name rlogin-program nil args)
 120           (setq proc (get-process buffer-name))
 121           ;; Set process-mark to point-max in case there is text in the
 122           ;; buffer from a previous exited process.
 123           (set-marker (process-mark proc) (point-max))
 124           (rlogin-mode)
 125           ;; Set this *after* running rlogin-mode because rlogin-mode calls
 126           ;; shell-mode, which munges the process filter.
 127           (set-process-filter proc 'rlogin-filter)
 128           ;; Set the prefix for filename completion and directory tracking
 129           ;; to find the remote machine's files by ftp.
 130           (setq comint-filename-prefix (concat "/" (car args) ":"))
 131           (and rlogin-initially-track-cwd
 132                ;; Presume the user will start in his remote home directory.
 133                ;; If this is wrong, M-x dirs will fix it.
 134                (cd-absolute (concat "/" (car args) ":~/")))))))
 135
 136 ;;;###autoload
 137 (defun rlogin-password (&optional proc)
 138   "Read a password and send it to an rlogin session.
 139 For each character typed, a `*' is echoed in the minibuffer.
 140 End with RET, LFD, or ESC.  DEL or C-h rubs out.  C-u kills line.
 141 C-g aborts attempt to read and send password.
 142
 143 Optional argument PROC is the process to which the password should be sent.
 144 If not provided, send to the process in the current buffer.  This argument
 145 is intended primarily for use by `rlogin-filter'."
 146   (interactive)
 147   (or proc (setq proc (get-buffer-process (current-buffer))))
 148   (let* ((buffer-name (buffer-name (process-buffer proc)))
 149          (pass (comint-read-noecho (format "Password for buffer \"%s\": "
 150                                            buffer-name)
 151                                    'stars)))
 152     (and pass
 153          (save-excursion
 154            (set-buffer buffer-name)
 155            (insert-before-markers "\n")
 156            (comint-send-string proc (format "%s\n" pass))))))
 157
 158 ;;;###autoload
 159 (defun rlogin-mode ()
 160   "Set major-mode for rlogin sessions.
 161 If `rlogin-mode-hook' is set, run it."
 162   (interactive)
 163   (kill-all-local-variables)
 164   (shell-mode)
 165   (setq major-mode 'rlogin-mode)
 166   (setq mode-name "rlogin")
 167   (use-local-map rlogin-mode-map)
 168   (setq shell-dirtrackp rlogin-initially-track-cwd)
 169   (make-local-variable 'comint-filename-prefix)
 170   (run-hooks 'rlogin-mode-hook))
 171
 172 \f
 173 (defun rlogin-filter (proc string)
 174   (let (proc-mark region-begin window)
 175     (save-excursion
 176       (set-buffer (process-buffer proc))
 177       (setq proc-mark (process-mark proc)
 178             region-begin (point)
 179             ;; If process mark is at window start, insert-before-markers
 180             ;; will insert text off-window since it's also inserting before
 181             ;; the start window mark.  Make sure we can see the most recent
 182             ;; text.  (note: it's a buglet that this isn't necessary if
 183             ;; scroll-step is 0, but that works to our advantage since it
 184             ;; makes the filter a little faster.)
 185             window (and (/= 0 scroll-step)
 186                         (= proc-mark (window-start))
 187                         (get-buffer-window (current-buffer))))
 188       (goto-char proc-mark)
 189       (insert-before-markers string)
 190       (goto-char region-begin)
 191       ;; I think something fishy is going on with save-excursion and
 192       ;; search-forward.  If you don't make search-forward move to the end
 193       ;; of the search region when it's done, then if the user switches
 194       ;; buffers back and forth, it leaves point sitting behind the
 195       ;; process-mark, so that text inserted later goes off-screen.
 196       (while (search-forward "\C-m" proc-mark 'goto-end)
 197         (delete-char -1)))
 198     ;; Frob window-start outside of save-excursion so it works whether the
 199     ;; current buffer is the process buffer or not.
 200     (and window
 201          (>= (window-start window) region-begin)
 202          (set-window-start window region-begin 'noforce)))
 203   (and rlogin-password-paranoia
 204        (string= "Password:" string)
 205        (rlogin-password proc)))
 206
 207 ;;;###autoload
 208 (defun rlogin-send-Ctrl-C ()
 209   (interactive)
 210   (send-string nil "\C-c"))
 211
 212 ;;;###autoload
 213 (defun rlogin-send-Ctrl-Z ()
 214   (interactive)
 215   (send-string nil "\C-z"))
 216
 217 ;;;###autoload
 218 (defun rlogin-send-Ctrl-backslash ()
 219   (interactive)
 220   (send-string nil "\C-\\"))
 221
 222 ;;;###autoload
 223 (defun rlogin-delchar-or-send-Ctrl-D (arg)
 224   "Delete ARG characters forward, or send a C-d to process if at end of
 225 buffer."
 226   (interactive "p")
 227   (if (eobp)
 228       (send-string nil "\C-d")
 229     (delete-char arg)))
 230
 231 ;;; rlogin.el ends here