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