;;; tramp.el --- Transparent Remote Access, Multiple Protocol
-;;; -*- mode: Emacs-Lisp; coding: utf-8; -*-
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; (copyright statements below in code to be updated with the above notice)
-;; Author: Kai Großjohann <kai.grossjohann@gmx.net>
+;; Author: Kai Großjohann <kai.grossjohann@gmx.net>
;; Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, see
-;; <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(require 'shell)
(require 'advice)
+(eval-and-compile
+ (if (featurep 'xemacs)
+ (load "auth-source" 'noerror)
+ (require 'auth-source nil 'noerror)))
+
;; Requiring 'tramp-cache results in an endless loop.
(autoload 'tramp-get-file-property "tramp-cache")
(autoload 'tramp-set-file-property "tramp-cache")
(require feature)
(add-hook 'tramp-unload-hook
`(lambda ()
- (when (featurep ,feature)
- (unload-feature ,feature 'force)))))))
+ (when (featurep (quote ,feature))
+ (unload-feature (quote ,feature) 'force)))))))
;;; User Customizable Internal Variables:
:group 'files
:version "22.1")
+;; Maybe we need once a real Tramp mode, with key bindings etc.
+;;;###autoload
+(defcustom tramp-mode t
+ "*Whether Tramp is enabled.
+If it is set to nil, all remote file names are used literally."
+ :group 'tramp
+ :type 'boolean)
+
(defcustom tramp-verbose 3
"*Verbosity level for Tramp.
Any level x includes messages for all levels 1 .. x-1. The levels are
(tramp-copy-keep-date t)
(tramp-password-end-of-line nil))
("scp" (tramp-login-program "ssh")
- (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
+ (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") ("-q")
("-e" "none")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program "scp")
("-o" "StrictHostKeyChecking=no")))
(tramp-default-port 22))
("scp1" (tramp-login-program "ssh")
- (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
+ (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") ("-q")
("-1" "-e" "none")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program "scp")
("-o" "StrictHostKeyChecking=no")))
(tramp-default-port 22))
("scp2" (tramp-login-program "ssh")
- (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
+ (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") ("-q")
("-2" "-e" "none")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program "scp")
(tramp-copy-keep-date nil)
(tramp-password-end-of-line nil))
("ssh" (tramp-login-program "ssh")
- (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
+ (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") ("-q")
("-e" "none")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program nil)
("-o" "StrictHostKeyChecking=no")))
(tramp-default-port 22))
("ssh1" (tramp-login-program "ssh")
- (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
+ (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") ("-q")
("-1" "-e" "none")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program nil)
("-o" "StrictHostKeyChecking=no")))
(tramp-default-port 22))
("ssh2" (tramp-login-program "ssh")
- (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
+ (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") ("-q")
("-2" "-e" "none")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program nil)
(tramp-copy-keep-date nil)
(tramp-password-end-of-line nil))
("scpc" (tramp-login-program "ssh")
- (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
+ (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") ("-q")
("-o" "ControlPath=%t.%%r@%%h:%%p")
("-o" "ControlMaster=yes")
("-e" "none")))
("-o" "StrictHostKeyChecking=no")))
(tramp-default-port 22))
("scpx" (tramp-login-program "ssh")
- (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
+ (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") ("-q")
("-e" "none" "-t" "-t" "/bin/sh")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program "scp")
("-o" "StrictHostKeyChecking=no")))
(tramp-default-port 22))
("sshx" (tramp-login-program "ssh")
- (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
+ (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") ("-q")
("-e" "none" "-t" "-t" "/bin/sh")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program nil)
("-ssh")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program "pscp")
- (tramp-copy-args (("-scp") ("-p" "%k")))
+ (tramp-copy-args (("-P" "%p") ("-scp") ("-p" "%k")))
(tramp-copy-keep-date t)
(tramp-password-end-of-line "xy") ;see docstring for "xy"
(tramp-default-port 22))
("-ssh")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program "pscp")
- (tramp-copy-args (("-psftp") ("-p" "%k")))
+ (tramp-copy-args (("-P" "%p") ("-sftp") ("-p" "%k")))
(tramp-copy-keep-date t)
(tramp-password-end-of-line "xy")) ;see docstring for "xy"
("fcp" (tramp-login-program "fsh")
(tramp-set-completion-function
"fcp" tramp-completion-function-alist-ssh)))
+(defconst tramp-echo-mark-marker "_echo"
+ "String marker to surround echoed commands.")
+
(defconst tramp-echo-mark "_echo\b\b\b\b\b"
"String mark to be transmitted around shell commands.
Used to separate their echo from the output they produce. This
will only be used if we cannot disable remote echo via stty.
This string must have no effect on the remote shell except for
producing some echo which can later be detected by
-`tramp-echoed-echo-mark-regexp'. Using some characters followed
-by an equal number of backspaces to erase them will usually
-suffice.")
+`tramp-echoed-echo-mark-regexp'. Using `tramp-echo-mark-marker',
+followed by an equal number of backspaces to erase them will
+usually suffice.")
(defconst tramp-echoed-echo-mark-regexp "_echo\\(\b\\( \b\\)?\\)\\{5\\}"
"Regexp which matches `tramp-echo-mark' as it gets echoed by
(defcustom tramp-remote-process-environment
`("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "LC_ALL=C"
,(concat "TERM=" tramp-terminal-type)
+ "EMACS=t" ;; Deprecated.
+ ,(format "INSIDE_EMACS=%s,tramp:%s" emacs-version tramp-version)
"CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH="
"autocorrect=" "correct=")
:group 'tramp
:type 'string)
+(defconst tramp-temp-buffer-name " *tramp temp*"
+ "Buffer name for a temporary buffer.
+It shall be used in combination with `generate-new-buffer-name'.")
+
(defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile"))
"*Alist specifying extra arguments to pass to the remote shell.
Entries are (REGEXP . ARGS) where REGEXP is a regular expression
Also see `tramp-file-name-structure'.")
;;;###autoload
-(defconst tramp-completion-file-name-regexp-unified
+(defconst tramp-root-regexp
(if (memq system-type '(cygwin windows-nt))
- "^\\([a-zA-Z]:\\)?/$\\|^\\([a-zA-Z]:\\)?/[^/:][^/]*$"
- "^/$\\|^/[^/:][^/]*$")
+ "^\\([a-zA-Z]:\\)?/"
+ "^/")
+ "Beginning of an incomplete Tramp file name.
+Usually, it is just \"^/\". On W32 systems, there might be a
+volume letter, which will be removed by `tramp-drop-volume-letter'.")
+
+;;;###autoload
+(defconst tramp-completion-file-name-regexp-unified
+ (concat tramp-root-regexp "[^/]*$")
"Value for `tramp-completion-file-name-regexp' for unified remoting.
-Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
-Tramp. See `tramp-file-name-structure' for more explanations.")
+GNU Emacs uses a unified filename syntax for Tramp and Ange-FTP.
+See `tramp-file-name-structure' for more explanations.")
;;;###autoload
(defconst tramp-completion-file-name-regexp-separate
- (if (memq system-type '(cygwin windows-nt))
- "^\\([a-zA-Z]:\\)?/\\([[][^]]*\\)?$"
- "^/\\([[][^]]*\\)?$")
+ (concat tramp-root-regexp "\\([[][^]]*\\)?$")
"Value for `tramp-completion-file-name-regexp' for separate remoting.
XEmacs uses a separate filename syntax for Tramp and EFS.
See `tramp-file-name-structure' for more explanations.")
;;;###autoload
(defconst tramp-completion-file-name-regexp-url
- (if (memq system-type '(cygwin windows-nt))
- "^\\([a-zA-Z]:\\)?/$\\|^\\([a-zA-Z]:\\)?/[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?$"
- "^/$\\|^/[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?$")
+ (concat tramp-root-regexp "[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?$")
"Value for `tramp-completion-file-name-regexp' for URL-like remoting.
See `tramp-file-name-structure' for more explanations.")
;; unless this spits out a complete line, including the '\n' at the
;; end.
;; The device number is returned as "-1", because there will be a virtual
-;; device number set in `tramp-handle-file-attributes'
+;; device number set in `tramp-handle-file-attributes'.
(defconst tramp-perl-file-attributes
"%s -e '
@stat = lstat($ARGV[0]);
$uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\";
$gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\";
printf(
- \"(\\\"%%s\\\" %%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u t (%%u . %%u) (%%u %%u))\\n\",
+ \"(\\\"%%s\\\" %%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u t (%%u . %%u) (%%u . %%u))\\n\",
$filename,
$type,
$stat[3],
(put 'with-connection-property 'edebug-form-spec t)
(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-connection-property\\>"))
-(defmacro tramp-let-maybe (variable value &rest body)
- "Let-bind VARIABLE to VALUE in BODY, but only if VARIABLE is not obsolete.
-BODY is executed whether or not the variable is obsolete.
-The intent is to protect against `obsolete variable' warnings."
- `(if (get ',variable 'byte-obsolete-variable)
- (progn ,@body)
- (let ((,variable ,value))
- ,@body)))
-(put 'tramp-let-maybe 'lisp-indent-function 2)
-(put 'tramp-let-maybe 'edebug-form-spec t)
+(eval-and-compile ; silence compiler
+ (if (memq system-type '(cygwin windows-nt))
+ (defun tramp-drop-volume-letter (name)
+ "Cut off unnecessary drive letter from file NAME.
+The function `tramp-handle-expand-file-name' calls `expand-file-name'
+locally on a remote file name. When the local system is a W32 system
+but the remote system is Unix, this introduces a superfluous drive
+letter into the file name. This function removes it."
+ (save-match-data
+ (if (string-match tramp-root-regexp name)
+ (replace-match "/" nil t name)
+ name)))
+
+ (defalias 'tramp-drop-volume-letter 'identity)))
(defsubst tramp-make-tramp-temp-file (vec)
"Create a temporary file on the remote host identified by VEC.
(tramp-file-name-method vec)
(tramp-file-name-user vec)
(tramp-file-name-host vec)
- (expand-file-name
- tramp-temp-name-prefix (tramp-get-remote-tmpdir vec))))
+ (tramp-drop-volume-letter
+ (expand-file-name
+ tramp-temp-name-prefix (tramp-get-remote-tmpdir vec)))))
result)
(while (not result)
;; `make-temp-file' would be the natural choice for
The FUNCTION is intended to parse FILE according its syntax.
It might be a predefined FUNCTION, or a user defined FUNCTION.
Predefined FUNCTIONs are `tramp-parse-rhosts', `tramp-parse-shosts',
-`tramp-parse-sconfig',`tramp-parse-hosts', `tramp-parse-passwd',
+`tramp-parse-sconfig', `tramp-parse-hosts', `tramp-parse-passwd',
and `tramp-parse-netrc'.
Example:
(when (boundp 'rfn-eshadow-setup-minibuffer-hook)
(add-hook 'rfn-eshadow-setup-minibuffer-hook
- 'tramp-rfn-eshadow-setup-minibuffer))
+ 'tramp-rfn-eshadow-setup-minibuffer)
+ (add-hook 'tramp-unload-hook
+ '(lambda ()
+ (remove-hook 'rfn-eshadow-setup-minibuffer-hook
+ 'tramp-rfn-eshadow-setup-minibuffer))))
(defun tramp-rfn-eshadow-update-overlay ()
"Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input.
target of the symlink differ."
(with-parsed-tramp-file-name linkname l
(let ((ln (tramp-get-remote-ln l))
- (cwd (file-name-directory l-localname)))
+ (cwd (tramp-run-real-handler
+ 'file-name-directory (list l-localname))))
(unless ln
(tramp-error
l 'file-error
(tramp-send-command-and-check
l (format "cd %s && %s -sf %s %s" cwd ln filename l-localname) t)))))
-
(defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix)
"Like `load' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name file) nil
(tramp-file-name-method v)
(tramp-file-name-user v)
(tramp-file-name-host v)
- (file-name-directory (or (tramp-file-name-localname v) "")))))
+ (tramp-run-real-handler
+ 'file-name-directory (list (or (tramp-file-name-localname v) ""))))))
(defun tramp-handle-file-name-nondirectory (file)
"Like `file-name-nondirectory' but aware of Tramp files."
(with-parsed-tramp-file-name file nil
- (file-name-nondirectory localname)))
+ (tramp-run-real-handler 'file-name-nondirectory (list localname))))
(defun tramp-handle-file-truename (filename &optional counter prev-dirs)
"Like `file-truename' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name filename) nil
(with-file-property v localname "file-truename"
- (let* ((steps (tramp-split-string localname "/"))
- (localnamedir (tramp-let-maybe directory-sep-char ?/ ;for XEmacs
- (file-name-as-directory localname)))
+ (let* ((directory-sep-char ?/) ; for XEmacs
+ (steps (tramp-split-string localname "/"))
+ (localnamedir (tramp-run-real-handler
+ 'file-name-as-directory (list localname)))
(is-dir (string= localname localnamedir))
(thisstep nil)
(numchase 0)
;; provided by "lstat" aren't unique, because we operate on different hosts.
;; So we use virtual device numbers, generated by Tramp. Both Ange-FTP and
;; EFS use device number "-1". In order to be different, we use device number
-;; (-1 x), whereby "x" is unique for a given (method user host).
+;; (-1 . x), whereby "x" is unique for a given (method user host).
(defvar tramp-devices nil
"Keeps virtual device numbers.")
(defun tramp-handle-file-modes (filename)
"Like `file-modes' for Tramp files."
- (when (file-exists-p filename)
- (tramp-mode-string-to-int
- (nth 8 (file-attributes filename)))))
+ (let ((truename (or (file-truename filename) filename)))
+ (when (file-exists-p truename)
+ (tramp-mode-string-to-int (nth 8 (file-attributes truename))))))
(defun tramp-handle-file-directory-p (filename)
"Like `file-directory-p' for Tramp files."
(let ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname)))
- (unless ok-if-already-exists
- (when (and t2 (file-exists-p newname))
- (with-parsed-tramp-file-name newname nil
- (tramp-error
- v 'file-already-exists "File %s already exists" newname))))
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (with-parsed-tramp-file-name (if t1 filename newname) nil
+ (tramp-error
+ v 'file-already-exists "File %s already exists" newname)))
(prog1
(cond
First arg OP is either `copy' or `rename' and indicates the operation.
FILENAME is the source file, NEWNAME the target file.
KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
- (let ((modtime (nth 5 (file-attributes filename))))
- (unwind-protect
- (with-temp-buffer
- (let ((coding-system-for-read 'binary))
- (insert-file-contents-literally filename))
- ;; We don't want the target file to be compressed, so we
- ;; let-bind `jka-compr-inhibit' to t.
- (let ((coding-system-for-write 'binary)
- (jka-compr-inhibit t))
- (write-region (point-min) (point-max) newname))))
- ;; KEEP-DATE handling.
- (when keep-date (set-file-times newname modtime))
- ;; Set the mode.
- (set-file-modes newname (file-modes filename))
- ;; If the operation was `rename', delete the original file.
- (unless (eq op 'copy)
- (delete-file filename))))
+ (with-temp-buffer
+ ;; We must disable multibyte, because binary data shall not be
+ ;; converted.
+ (set-buffer-multibyte nil)
+ (let ((coding-system-for-read 'binary)
+ (jka-compr-inhibit t))
+ (insert-file-contents-literally filename))
+ ;; We don't want the target file to be compressed, so we let-bind
+ ;; `jka-compr-inhibit' to t.
+ (let ((coding-system-for-write 'binary)
+ (jka-compr-inhibit t))
+ (write-region (point-min) (point-max) newname)))
+ ;; KEEP-DATE handling.
+ (when keep-date (set-file-times newname (nth 5 (file-attributes filename))))
+ ;; Set the mode.
+ (set-file-modes newname (file-modes filename))
+ ;; If the operation was `rename', delete the original file.
+ (unless (eq op 'copy) (delete-file filename)))
(defun tramp-do-copy-or-rename-file-directly
(op filename newname ok-if-already-exists keep-date preserve-uid-gid)
((or t1 t2)
(cond
;; We can do it directly.
- ((and (file-readable-p localname1)
- (file-writable-p (file-name-directory localname2))
- (or (file-directory-p localname2)
- (file-writable-p localname2)))
+ ((let (file-name-handler-alist)
+ (and (file-readable-p localname1)
+ (file-writable-p (file-name-directory localname2))
+ (or (file-directory-p localname2)
+ (file-writable-p localname2))))
(if (eq op 'copy)
(tramp-compat-copy-file
localname1 localname2 ok-if-already-exists
keep-date preserve-uid-gid)
- (rename-file localname1 localname2 ok-if-already-exists)))
+ (tramp-run-real-handler
+ 'rename-file (list localname1 localname2 ok-if-already-exists))))
;; We can do it directly with `tramp-send-command'
- ((and (file-readable-p (concat prefix localname1))
+ ((let (file-name-handler-alist)
+ (and (file-readable-p (concat prefix localname1))
(file-writable-p
- (file-name-directory (concat prefix localname2))))
+ (file-name-directory (concat prefix localname2)))))
(tramp-do-copy-or-rename-file-directly
op (concat prefix localname1) (concat prefix localname2)
ok-if-already-exists keep-date t)
(tramp-compat-copy-file
localname1 tmpfile ok-if-already-exists
keep-date preserve-uid-gid)
- (rename-file localname1 tmpfile ok-if-already-exists))
+ (tramp-run-real-handler
+ 'rename-file (list localname1 tmpfile ok-if-already-exists)))
;; We must change the ownership as local user.
(tramp-set-file-uid-gid
tmpfile
(tramp-shell-quote-argument tmpfile)
(tramp-shell-quote-argument localname2))))
(t1
- (rename-file tmpfile localname2 ok-if-already-exists)))))))))
+ (tramp-run-real-handler
+ 'rename-file
+ (list tmpfile localname2 ok-if-already-exists))))))))))
;; Set the time and mode. Mask possible errors.
;; Won't be applied for 'rename.
(set-file-modes newname (file-modes filename)))
(error)))))
-
(defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date)
"Invoke rcp program to copy.
One of FILENAME and NEWNAME must be a Tramp name, the other must
(append copy-args (list source target))))))
(tramp-message
v 6 "%s" (mapconcat 'identity (process-command p) " "))
- (set-process-sentinel p 'tramp-process-sentinel)
(tramp-set-process-query-on-exit-flag p nil)
(tramp-process-actions p v tramp-actions-copy-out-of-band))))
switches filename (if wildcard "yes" "no")
(if full-directory-p "yes" "no"))
(when wildcard
- (setq wildcard (file-name-nondirectory localname))
- (setq localname (file-name-directory localname)))
+ (setq wildcard (tramp-run-real-handler
+ 'file-name-nondirectory (list localname)))
+ (setq localname (tramp-run-real-handler
+ 'file-name-directory (list localname))))
(when (listp switches)
(setq switches (mapconcat 'identity switches " ")))
(unless full-directory-p
(tramp-barf-unless-okay
v
(format "cd %s" (tramp-shell-quote-argument
- (file-name-directory localname)))
+ (tramp-run-real-handler
+ 'file-name-directory (list localname))))
"Couldn't `cd %s'"
- (tramp-shell-quote-argument (file-name-directory localname)))
+ (tramp-shell-quote-argument
+ (tramp-run-real-handler 'file-name-directory (list localname))))
(tramp-send-command
v
(format "%s %s %s"
(tramp-get-ls-command v)
switches
(if (or wildcard
- (zerop (length (file-name-nondirectory localname))))
+ (zerop (length
+ (tramp-run-real-handler
+ 'file-name-nondirectory (list localname)))))
""
(tramp-shell-quote-argument
- (file-name-nondirectory localname))))))
+ (tramp-run-real-handler
+ 'file-name-nondirectory (list localname)))))))
;; We cannot use `insert-buffer-substring' because the Tramp buffer
;; changes its contents before insertion due to calling
;; `expand-file' and alike.
(with-current-buffer (tramp-get-buffer v)
(buffer-string))))))
-;; CCC is this the right thing to do?
(defun tramp-handle-unhandled-file-name-directory (filename)
"Like `unhandled-file-name-directory' for Tramp files."
+ ;; With Emacs 23, we could simply return `nil'. But we must keep it
+ ;; for backward compatibility.
(expand-file-name "~/"))
;; Canonicalization of file names.
-(defun tramp-drop-volume-letter (name)
- "Cut off unnecessary drive letter from file NAME.
-The function `tramp-handle-expand-file-name' calls `expand-file-name'
-locally on a remote file name. When the local system is a W32 system
-but the remote system is Unix, this introduces a superfluous drive
-letter into the file name. This function removes it.
-
-Doesn't do anything if the NAME does not start with a drive letter."
- (if (and (> (length name) 1)
- (char-equal (aref name 1) ?:)
- (let ((c1 (aref name 0)))
- (or (and (>= c1 ?A) (<= c1 ?Z))
- (and (>= c1 ?a) (<= c1 ?z)))))
- (substring name 2)
- name))
-
(defun tramp-handle-expand-file-name (name &optional dir)
"Like `expand-file-name' for Tramp files.
If the localname part of the given filename starts with \"/../\" then
(tramp-run-real-handler 'expand-file-name (list name nil))
;; Dissect NAME.
(with-parsed-tramp-file-name name nil
- (unless (file-name-absolute-p localname)
+ (unless (tramp-run-real-handler 'file-name-absolute-p (list localname))
(setq localname (concat "~/" localname)))
;; Tilde expansion if necessary. This needs a shell which
;; groks tilde expansion! The function `tramp-find-shell' is
;; would otherwise use backslash. `default-directory' is
;; bound, because on Windows there would be problems with UNC
;; shares or Cygwin mounts.
- (tramp-let-maybe directory-sep-char ?/
- (let ((default-directory (tramp-compat-temporary-file-directory)))
- (tramp-make-tramp-file-name
- method user host
- (tramp-drop-volume-letter
- (tramp-run-real-handler 'expand-file-name
- (list localname)))))))))
+ (let ((directory-sep-char ?/)
+ (default-directory (tramp-compat-temporary-file-directory)))
+ (tramp-make-tramp-file-name
+ method user host
+ (tramp-drop-volume-letter
+ (tramp-run-real-handler
+ 'expand-file-name (list localname))))))))
+
+(defun tramp-replace-environment-variables (filename)
+ "Replace environment variables in FILENAME.
+Return the string with the replaced variables."
+ (save-match-data
+ (let ((idx (string-match "$\\w+" filename)))
+ ;; `$' is coded as `$$'.
+ (when (and idx (or (zerop idx) (not (eq ?$ (aref filename (1- idx))))))
+ (setq filename
+ (replace-match
+ (substitute-in-file-name (match-string 0 filename))
+ t nil filename)))
+ filename)))
(defun tramp-handle-substitute-in-file-name (filename)
"Like `substitute-in-file-name' for Tramp files.
\"//\" and \"/~\" substitute only in the local filename part.
If the URL Tramp syntax is chosen, \"//\" as method delimeter and \"/~\" at
beginning of local filename are not substituted."
+ ;; First, we must replace environment variables.
+ (setq filename (tramp-replace-environment-variables filename))
(with-parsed-tramp-file-name filename nil
(if (equal tramp-syntax 'url)
;; We need to check localname only. The other parts cannot contain
(when method (substitute-in-file-name method))
(when user (substitute-in-file-name user))
(when host (substitute-in-file-name host))
- (when localname (substitute-in-file-name localname))))
+ (when localname
+ (tramp-run-real-handler
+ 'substitute-in-file-name (list localname)))))
;; Ignore in LOCALNAME everything before "//" or "/~".
(when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
(setq filename
"Like `start-file-process' for Tramp files."
(with-parsed-tramp-file-name default-directory nil
(unwind-protect
- (progn
+ (let ((name1 name)
+ (i 0))
+ (unless buffer
+ ;; BUFFER can be nil. We use a temporary buffer.
+ (setq buffer (generate-new-buffer tramp-temp-buffer-name)))
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+ (setq name name1)
;; Set the new process properties.
(tramp-set-connection-property v "process-name" name)
- (tramp-set-connection-property
- v "process-buffer"
- ;; BUFFER can be nil.
- (get-buffer-create (or buffer (current-buffer))))
+ (tramp-set-connection-property v "process-buffer" buffer)
;; Activate narrowing in order to save BUFFER contents.
+ ;; Clear also the modification time; otherwise we might be
+ ;; interrupted by `verify-visited-file-modtime'.
(with-current-buffer (tramp-get-connection-buffer v)
+ (clear-visited-file-modtime)
(narrow-to-region (point-max) (point-max)))
;; Goto working directory. `tramp-send-command' opens a new
;; connection.
;; Send the command.
(tramp-send-command
v
- (format "%s; echo %s; exit"
+ (format "exec %s"
(mapconcat 'tramp-shell-quote-argument
- (cons program args) " ")
- (tramp-shell-quote-argument tramp-end-of-output))
+ (cons program args) " "))
nil t) ; nooutput
+ ;; Set query flag for this process.
+ (tramp-set-process-query-on-exit-flag
+ (tramp-get-connection-process v) t)
;; Return process.
(tramp-get-connection-process v))
;; Save exit.
(with-current-buffer (tramp-get-connection-buffer v)
- (widen)
- (goto-char (point-max)))
+ (if (string-match tramp-temp-buffer-name (buffer-name))
+ (progn
+ (set-process-buffer (tramp-get-connection-process v) nil)
+ (kill-buffer (current-buffer)))
+ (widen)
+ (goto-char (point-max))))
(tramp-set-connection-property v "process-name" nil)
(tramp-set-connection-property v "process-buffer" nil))))
;; We cannot use `shell-file-name' and `shell-command-switch',
;; they are variables of the local host.
(args (list "/bin/sh" "-c" (substring command 0 asynchronous)))
+ current-buffer-p
(output-buffer
(cond
((bufferp output-buffer) output-buffer)
((stringp output-buffer) (get-buffer-create output-buffer))
- (output-buffer (current-buffer))
+ (output-buffer
+ (setq current-buffer-p t)
+ (current-buffer))
(t (get-buffer-create
(if asynchronous
"*Async Shell Command*"
;; support 2 (asynchronous) processes in parallel.
(when p
(if (yes-or-no-p "A command is running. Kill it? ")
- (ignore-errors (kill-process p))
+ (condition-case nil
+ (kill-process p)
+ (error nil))
(error "Shell command in progress")))
- (with-current-buffer output-buffer
- (setq buffer-read-only nil
- buffer-undo-list t)
- (erase-buffer))
+ (if current-buffer-p
+ (progn
+ (barf-if-buffer-read-only)
+ (push-mark nil t))
+ (with-current-buffer output-buffer
+ (setq buffer-read-only nil)
+ (erase-buffer)))
- (if (integerp asynchronous)
+ (if (and (not current-buffer-p) (integerp asynchronous))
(prog1
;; Run the process.
(apply 'start-file-process "*Async Shell*" buffer args)
(with-current-buffer error-buffer
(insert-file-contents (cadr buffer)))
(delete-file (cadr buffer)))
- ;; There's some output, display it.
- (when (with-current-buffer output-buffer (> (point-max) (point-min)))
- (if (functionp 'display-message-or-buffer)
- (funcall (symbol-function 'display-message-or-buffer)
- output-buffer)
- (pop-to-buffer output-buffer)))))))
+ (if current-buffer-p
+ ;; This is like exchange-point-and-mark, but doesn't
+ ;; activate the mark. It is cleaner to avoid activation,
+ ;; even though the command loop would deactivate the mark
+ ;; because we inserted text.
+ (goto-char (prog1 (mark t)
+ (set-marker (mark-marker) (point)
+ (current-buffer))))
+ ;; There's some output, display it.
+ (when (with-current-buffer output-buffer (> (point-max) (point-min)))
+ (if (functionp 'display-message-or-buffer)
+ (funcall (symbol-function 'display-message-or-buffer)
+ output-buffer)
+ (pop-to-buffer output-buffer))))))))
;; File Editing.
((eq identification 'localname) localname)
(t (tramp-make-tramp-file-name method user host "")))))))
+(defun tramp-find-file-name-coding-system-alist (filename tmpname)
+ "Like `find-operation-coding-system' for Tramp filenames.
+Tramp's `insert-file-contents' and `write-region' work over
+temporary file names. If `file-coding-system-alist' contains an
+expression, which matches more than the file name suffix, the
+coding system might not be determined. This function repairs it."
+ (let (result)
+ (dolist (elt file-coding-system-alist result)
+ (when (and (consp elt) (string-match (car elt) filename))
+ ;; We found a matching entry in `file-coding-system-alist'.
+ ;; So we add a similar entry, but with the temporary file name
+ ;; as regexp.
+ (add-to-list
+ 'result (cons (regexp-quote tmpname) (cdr elt)) 'append)))))
+
(defun tramp-handle-insert-file-contents
(filename &optional visit beg end replace)
"Like `insert-file-contents' for Tramp files."
(list (expand-file-name filename) 0))
(if (and (tramp-local-host-p v)
- (file-readable-p localname))
+ (let (file-name-handler-alist) (file-readable-p localname)))
;; Short track: if we are on the local host, we can run directly.
- (setq result (insert-file-contents localname visit beg end replace))
+ (setq result
+ (tramp-run-real-handler
+ 'insert-file-contents
+ (list localname visit beg end replace)))
;; `insert-file-contents-literally' takes care to avoid calling
;; jka-compr. By let-binding inhibit-file-name-operation, we
'file-local-copy)))
(file-local-copy filename))))
(tramp-message v 4 "Inserting local temp file `%s'..." local-copy)
- (setq result (insert-file-contents local-copy nil beg end replace))
- ;; Now `last-coding-system-used' has right value. Remember it.
- (when (boundp 'last-coding-system-used)
- (setq coding-system-used (symbol-value 'last-coding-system-used)))
- (tramp-message v 4 "Inserting local temp file `%s'...done" local-copy)
+ ;; We must ensure that `file-coding-system-alist' matches
+ ;; `local-copy'.
+ (let ((file-coding-system-alist
+ (tramp-find-file-name-coding-system-alist
+ filename local-copy)))
+ (setq result
+ (insert-file-contents local-copy nil beg end replace))
+ ;; Now `last-coding-system-used' has right value. Remember it.
+ (when (boundp 'last-coding-system-used)
+ (setq coding-system-used
+ (symbol-value 'last-coding-system-used))))
+ (tramp-message
+ v 4 "Inserting local temp file `%s'...done" local-copy)
(delete-file local-copy)
(when (boundp 'last-coding-system-used)
(set 'last-coding-system-used coding-system-used))))
(tramp-get-remote-gid v 'integer))))
(if (and (tramp-local-host-p v)
- (file-writable-p (file-name-directory localname))
- (or (file-directory-p localname)
- (file-writable-p localname)))
+ ;; `file-writable-p' calls 'file-expand-file-name'. We
+ ;; cannot use `tramp-run-real-handler' therefore.
+ (let (file-name-handler-alist)
+ (and
+ (file-writable-p (file-name-directory localname))
+ (or (file-directory-p localname)
+ (file-writable-p localname)))))
;; Short track: if we are on the local host, we can run directly.
- (write-region start end localname append 'no-message lockname confirm)
+ (tramp-run-real-handler
+ 'write-region
+ (list start end localname append 'no-message lockname confirm))
(let ((rem-dec (tramp-get-remote-coding v "remote-decoding"))
(loc-enc (tramp-get-local-coding v "local-encoding"))
;; We say `no-message' here because we don't want the
;; visited file modtime data to be clobbered from the temp
;; file. We call `set-visited-file-modtime' ourselves later
- ;; on.
- (tramp-run-real-handler
- 'write-region
- (list start end tmpfile append 'no-message lockname confirm))
- ;; Now, `last-coding-system-used' has the right value. Remember it.
- (when (boundp 'last-coding-system-used)
- (setq coding-system-used (symbol-value 'last-coding-system-used)))
+ ;; on. We must ensure that `file-coding-system-alist'
+ ;; matches `tmpfile'.
+ (let ((file-coding-system-alist
+ (tramp-find-file-name-coding-system-alist filename tmpfile)))
+ (tramp-run-real-handler
+ 'write-region
+ (list start end tmpfile append 'no-message lockname confirm))
+ ;; Now, `last-coding-system-used' has the right value. Remember it.
+ (when (boundp 'last-coding-system-used)
+ (setq coding-system-used
+ (symbol-value 'last-coding-system-used))))
+
;; The permissions of the temporary file should be set. If
;; filename does not exist (eq modes nil) it has been
;; renamed to the backup file. This case `save-buffer'
(when coding-system-used
(set 'last-coding-system-used coding-system-used))))
- ;; Set file modification time.
- (when (or (eq visit t) (stringp visit))
- (set-visited-file-modtime
- ;; We must pass modtime explicitely, because filename can
- ;; be different from (buffer-file-name), f.e. if
- ;; `file-precious-flag' is set.
- (nth 5 (file-attributes filename))))
-
- ;; Set the ownership.
- (tramp-set-file-uid-gid filename uid gid)
- (when (or (eq visit t) (null visit) (stringp visit))
- (tramp-message v 0 "Wrote %s" filename))
- (run-hooks 'tramp-handle-write-region-hook))))
+ ;; We must protect `last-coding-system-used', now we have set it
+ ;; to its correct value.
+ (let (last-coding-system-used)
+ ;; Set file modification time.
+ (when (or (eq visit t) (stringp visit))
+ (set-visited-file-modtime
+ ;; We must pass modtime explicitely, because filename can
+ ;; be different from (buffer-file-name), f.e. if
+ ;; `file-precious-flag' is set.
+ (nth 5 (file-attributes filename))))
+
+ ;; Set the ownership.
+ (tramp-set-file-uid-gid filename uid gid)
+ (when (or (eq visit t) (null visit) (stringp visit))
+ (tramp-message v 0 "Wrote %s" filename))
+ (run-hooks 'tramp-handle-write-region-hook)))))
;;;###autoload
(progn (defun tramp-run-real-handler (operation args)
;; We handle here all file primitives. Most of them have the file
;; name as first parameter; nevertheless we check for them explicitly
-;; in order to be signalled if a new primitive appears. This
+;; in order to be signaled if a new primitive appears. This
;; scenario is needed because there isn't a way to decide by
;; syntactical means whether a foreign method must be called. It would
;; ease the life if `file-name-handler-alist' would support a decision
'dired-file-modtime 'dired-make-compressed-filename
'dired-recursive-delete-directory 'dired-set-file-modtime
'dired-shell-unhandle-file-name 'dired-uucode-file
- 'insert-file-contents-literally 'recover-file
+ 'insert-file-contents-literally 'make-temp-name 'recover-file
'vm-imap-check-mail 'vm-pop-check-mail 'vm-spool-check-mail))
(if (file-name-absolute-p (nth 0 args))
(nth 0 args)
(defun tramp-file-name-handler (operation &rest args)
"Invoke Tramp file name handler.
Falls back to normal file name handler if no Tramp file name handler exists."
- (save-match-data
- (let* ((filename (apply 'tramp-file-name-for-operation operation args))
- (completion (tramp-completion-mode-p))
- (foreign (tramp-find-foreign-file-name-handler filename)))
- (with-parsed-tramp-file-name filename nil
- (cond
- ;; When we are in completion mode, some operations shouldn't be
- ;; handled by backend.
- ((and completion (zerop (length localname))
- (memq operation '(file-exists-p file-directory-p)))
- t)
- ((and completion (zerop (length localname))
- (memq operation '(file-name-as-directory)))
- filename)
- ;; Call the backend function.
- (foreign (apply foreign operation args))
- ;; Nothing to do for us.
- (t (tramp-run-real-handler operation args)))))))
+ (if tramp-mode
+ (save-match-data
+ (let* ((filename
+ (tramp-replace-environment-variables
+ (apply 'tramp-file-name-for-operation operation args)))
+ (completion (tramp-completion-mode-p))
+ (foreign (tramp-find-foreign-file-name-handler filename)))
+ (with-parsed-tramp-file-name filename nil
+ (cond
+ ;; When we are in completion mode, some operations
+ ;; shouldn't be handled by backend.
+ ((and completion (zerop (length localname))
+ (memq operation '(file-exists-p file-directory-p)))
+ t)
+ ((and completion (zerop (length localname))
+ (memq operation '(file-name-as-directory)))
+ filename)
+ ;; Call the backend function.
+ (foreign (apply foreign operation args))
+ ;; Nothing to do for us.
+ (t (tramp-run-real-handler operation args))))))
+ ;; When `tramp-mode' is not enabled, we don't do anything.
+ (tramp-run-real-handler operation args)))
;; In Emacs, there is some concurrency due to timers. If a timer
;; interrupts Tramp and wishes to use the same connection buffer as
"Invoke remote-shell Tramp file name handler.
Fall back to normal file name handler if no Tramp handler exists."
(when (and tramp-locked (not tramp-locker))
+ (setq tramp-locked nil)
(signal 'file-error (list "Forbidden reentrant call of Tramp")))
(let ((tl tramp-locked))
(unwind-protect
(progn (defun tramp-completion-file-name-handler (operation &rest args)
"Invoke Tramp file name completion handler.
Falls back to normal file name handler if no Tramp file name handler exists."
-;; (setq edebug-trace t)
-;; (edebug-trace "%s" (with-output-to-string (backtrace)))
-
-;; (mapcar 'trace-function-background
-;; (mapcar 'intern
-;; (all-completions "tramp-" obarray 'functionp)))
-
- (let ((fn (assoc operation tramp-completion-file-name-handler-alist)))
- (if fn
+ ;; We bind `directory-sep-char' here for XEmacs on Windows, which
+ ;; would otherwise use backslash.
+ (let ((directory-sep-char ?/)
+ (fn (assoc operation tramp-completion-file-name-handler-alist)))
+ ;; When `tramp-mode' is not enabled, we don't do anything.
+ (if (and fn tramp-mode)
(save-match-data (apply (cdr fn) args))
(tramp-completion-run-real-handler operation args)))))
;; `tramp-completion-file-name-handler' will be delayed.
;;;###autoload(add-hook
;;;###autoload 'after-init-hook
-;;;###autoload '(lambda () (tramp-register-completion-file-name-handler)))
+;;;###autoload 'tramp-register-completion-file-name-handler)
(tramp-register-completion-file-name-handler)
;;;###autoload
(and (natnump last-input-event)
(or
;; ?\t has event-modifier 'control.
- (char-equal last-input-event ?\t)
+ (equal last-input-event ?\t)
(and (not (event-modifiers last-input-event))
- (or (char-equal last-input-event ?\?)
- (char-equal last-input-event ?\ )))))
+ (or (equal last-input-event ?\?)
+ (equal last-input-event ?\ )))))
;; XEmacs.
(and (featurep 'xemacs)
;; `last-input-event' might be nil.
(funcall (symbol-function 'event-to-character) last-input-event)
(or
;; ?\t has event-modifier 'control.
- (char-equal
+ (equal
(funcall (symbol-function 'event-to-character)
last-input-event) ?\t)
(and (not (event-modifiers last-input-event))
- (or (char-equal
+ (or (equal
(funcall (symbol-function 'event-to-character)
last-input-event) ?\?)
- (char-equal
+ (equal
(funcall (symbol-function 'event-to-character)
last-input-event) ?\ )))))))
(setq todo actions)
(while todo
(setq item (pop todo))
- (setq pattern (concat (symbol-value (nth 0 item)) "\\'"))
+ (setq pattern (format "\\(%s\\)\\'" (symbol-value (nth 0 item))))
(setq action (nth 1 item))
(tramp-message
vec 5 "Looking for regexp \"%s\" from remote shell" pattern)
Erase echoed commands if exists."
(with-current-buffer (process-buffer proc)
(goto-char (point-min))
+
;; Check whether we need to remove echo output.
(when (and (tramp-get-connection-property proc "check-remote-echo" nil)
(re-search-forward tramp-echoed-echo-mark-regexp nil t))
(forward-line)
(delete-region begin (point))
(goto-char (point-min)))))
- ;; No echo to be handled, now we can look for the regexp.
- (when (not (tramp-get-connection-property proc "check-remote-echo" nil))
+
+ (when (or
+ ;; No echo to be handled, now we can look for the regexp.
+ (not (tramp-get-connection-property proc "check-remote-echo" nil))
+ ;; Sometimes the echo is invisible.
+ (not (re-search-forward tramp-echo-mark-marker nil t)))
+ (goto-char (point-min))
(re-search-forward regexp nil t))))
(defun tramp-wait-for-regexp (proc timeout regexp)
'tramp-password-end-of-line)
tramp-default-password-end-of-line))))
-(defun tramp-process-sentinel (proc event)
- "Process sentinel for Tramp processes."
- (when (memq (process-status proc) '(stop exit signal))
- (tramp-flush-connection-property proc)
- ;; The "Connection closed" and "exit" messages disturb the output
- ;; for asynchronous processes. That's why we have echoed the Tramp
- ;; prompt at the end. Trailing messages can be removed.
- (let ((buf (process-buffer proc)))
- (when (buffer-live-p buf)
- (with-current-buffer buf
- (goto-char (point-max))
- (re-search-backward
- (mapconcat 'identity (split-string tramp-end-of-output "\n")
- "\r?\n")
- (line-beginning-position -8) t)
- (delete-region (point) (point-max)))))))
-
(defun tramp-open-connection-setup-interactive-shell (proc vec)
"Set up an interactive shell.
Mainly sets the prompt and the echo correctly. PROC is the shell
;; Check whether the output of "uname -sr" has been changed. If
;; yes, this is a strong indication that we must expire all
- ;; connection properties.
+ ;; connection properties. We start again with
+ ;; `tramp-maybe-open-connection', it will be catched there.
(tramp-message vec 5 "Checking system information")
(let ((old-uname (tramp-get-connection-property vec "uname" nil))
(new-uname
vec "uname"
(tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\""))))
(when (and (stringp old-uname) (not (string-equal old-uname new-uname)))
- (funcall (symbol-function 'tramp-cleanup-connection) vec)
- (signal
- 'quit
- (list (format
- "Connection reset, because remote host changed from `%s' to `%s'"
- old-uname new-uname)))))
+ (with-current-buffer (tramp-get-debug-buffer vec)
+ ;; Keep the debug buffer
+ (rename-buffer
+ (generate-new-buffer-name tramp-temp-buffer-name) 'unique)
+ (funcall (symbol-function 'tramp-cleanup-connection) vec)
+ (if (= (point-min) (point-max))
+ (kill-buffer nil)
+ (rename-buffer (tramp-debug-buffer-name vec) 'unique))
+ ;; We call `tramp-get-buffer' in order to keep the debug buffer.
+ (tramp-get-buffer vec)
+ (tramp-message
+ vec 3
+ "Connection reset, because remote host changed from `%s' to `%s'"
+ old-uname new-uname)
+ (throw 'uname-changed (tramp-maybe-open-connection vec)))))
;; Check whether the remote host suffers from buggy
;; `send-process-string'. This is known for FreeBSD (see comment in
"Maybe open a connection VEC.
Does not do anything if a connection is already open, but re-opens the
connection if a previous connection has died for some reason."
- (let ((p (tramp-get-connection-process vec))
- (process-environment (copy-sequence process-environment)))
-
- ;; If too much time has passed since last command was sent, look
- ;; whether process is still alive. If it isn't, kill it. When
- ;; using ssh, it can sometimes happen that the remote end has hung
- ;; up but the local ssh client doesn't recognize this until it
- ;; tries to send some data to the remote end. So that's why we
- ;; try to send a command from time to time, then look again
- ;; whether the process is really alive.
- (condition-case nil
- (when (and (> (tramp-time-diff
- (current-time)
- (tramp-get-connection-property
- p "last-cmd-time" '(0 0 0)))
- 60)
- p (processp p) (memq (process-status p) '(run open)))
- (tramp-send-command vec "echo are you awake" t t)
- (unless (and (memq (process-status p) '(run open))
- (tramp-wait-for-output p 10))
- ;; The error will be catched locally.
- (tramp-error vec 'file-error "Awake did fail")))
- (file-error
- (tramp-flush-connection-property vec nil)
- (tramp-flush-connection-property p nil)
- (delete-process p)
- (setq p nil)))
-
- ;; New connection must be opened.
- (unless (and p (processp p) (memq (process-status p) '(run open)))
-
- ;; We call `tramp-get-buffer' in order to get a debug buffer for
- ;; messages from the beginning.
- (tramp-get-buffer vec)
- (if (zerop (length (tramp-file-name-user vec)))
+ (catch 'uname-changed
+ (let ((p (tramp-get-connection-process vec))
+ (process-environment (copy-sequence process-environment)))
+
+ ;; If too much time has passed since last command was sent, look
+ ;; whether process is still alive. If it isn't, kill it. When
+ ;; using ssh, it can sometimes happen that the remote end has
+ ;; hung up but the local ssh client doesn't recognize this until
+ ;; it tries to send some data to the remote end. So that's why
+ ;; we try to send a command from time to time, then look again
+ ;; whether the process is really alive.
+ (condition-case nil
+ (when (and (> (tramp-time-diff
+ (current-time)
+ (tramp-get-connection-property
+ p "last-cmd-time" '(0 0 0)))
+ 60)
+ p (processp p) (memq (process-status p) '(run open)))
+ (tramp-send-command vec "echo are you awake" t t)
+ (unless (and (memq (process-status p) '(run open))
+ (tramp-wait-for-output p 10))
+ ;; The error will be catched locally.
+ (tramp-error vec 'file-error "Awake did fail")))
+ (file-error
+ (tramp-flush-connection-property vec)
+ (tramp-flush-connection-property p)
+ (delete-process p)
+ (setq p nil)))
+
+ ;; New connection must be opened.
+ (unless (and p (processp p) (memq (process-status p) '(run open)))
+
+ ;; We call `tramp-get-buffer' in order to get a debug buffer for
+ ;; messages from the beginning.
+ (tramp-get-buffer vec)
+ (if (zerop (length (tramp-file-name-user vec)))
+ (tramp-message
+ vec 3 "Opening connection for %s using %s..."
+ (tramp-file-name-host vec)
+ (tramp-file-name-method vec))
(tramp-message
- vec 3 "Opening connection for %s using %s..."
+ vec 3 "Opening connection for %s@%s using %s..."
+ (tramp-file-name-user vec)
(tramp-file-name-host vec)
- (tramp-file-name-method vec))
- (tramp-message
- vec 3 "Opening connection for %s@%s using %s..."
- (tramp-file-name-user vec)
- (tramp-file-name-host vec)
- (tramp-file-name-method vec)))
-
- ;; Start new process.
- (when (and p (processp p))
- (delete-process p))
- (setenv "TERM" tramp-terminal-type)
- (setenv "LC_ALL" "C")
- (setenv "PROMPT_COMMAND")
- (setenv "PS1" "$ ")
- (let* ((target-alist (tramp-compute-multi-hops vec))
- (process-connection-type tramp-process-connection-type)
- (process-adaptive-read-buffering nil)
- (coding-system-for-read nil)
- ;; This must be done in order to avoid our file name handler.
- (p (let ((default-directory
- (tramp-compat-temporary-file-directory)))
- (start-process
- (or (tramp-get-connection-property vec "process-name" nil)
- (tramp-buffer-name vec))
- (tramp-get-connection-buffer vec)
- tramp-encoding-shell)))
- (first-hop t))
+ (tramp-file-name-method vec)))
+
+ ;; Start new process.
+ (when (and p (processp p))
+ (delete-process p))
+ (setenv "TERM" tramp-terminal-type)
+ (setenv "LC_ALL" "C")
+ (setenv "PROMPT_COMMAND")
+ (setenv "PS1" "$ ")
+ (let* ((target-alist (tramp-compute-multi-hops vec))
+ (process-connection-type tramp-process-connection-type)
+ (process-adaptive-read-buffering nil)
+ (coding-system-for-read nil)
+ ;; This must be done in order to avoid our file name handler.
+ (p (let ((default-directory
+ (tramp-compat-temporary-file-directory)))
+ (start-process
+ (or (tramp-get-connection-property vec "process-name" nil)
+ (tramp-buffer-name vec))
+ (tramp-get-connection-buffer vec)
+ tramp-encoding-shell)))
+ (first-hop t))
- (tramp-message
- vec 6 "%s" (mapconcat 'identity (process-command p) " "))
-
- ;; Check whether process is alive.
- (set-process-sentinel p 'tramp-process-sentinel)
- (tramp-set-process-query-on-exit-flag p nil)
- (tramp-message vec 3 "Waiting 60s for local shell to come up...")
- (tramp-barf-if-no-shell-prompt
- p 60 "Couldn't find local shell prompt %s" tramp-encoding-shell)
-
- ;; Now do all the connections as specified.
- (while target-alist
- (let* ((hop (car target-alist))
- (l-method (tramp-file-name-method hop))
- (l-user (tramp-file-name-user hop))
- (l-host (tramp-file-name-host hop))
- (l-port nil)
- (login-program
- (tramp-get-method-parameter l-method 'tramp-login-program))
- (login-args
- (tramp-get-method-parameter l-method 'tramp-login-args))
- (gw-args
- (tramp-get-method-parameter l-method 'tramp-gw-args))
- (gw (tramp-get-file-property hop "" "gateway" nil))
- (g-method (and gw (tramp-file-name-method gw)))
- (g-user (and gw (tramp-file-name-user gw)))
- (g-host (and gw (tramp-file-name-host gw)))
- (command login-program)
- ;; We don't create the temporary file. In fact, it
- ;; is just a prefix for the ControlPath option of
- ;; ssh; the real temporary file has another name, and
- ;; it is created and protected by ssh. It is also
- ;; removed by ssh, when the connection is closed.
- (tmpfile
- (tramp-set-connection-property
- p "temp-file"
- (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix
- (tramp-compat-temporary-file-directory)))))
- spec)
-
- ;; Add gateway arguments if necessary.
- (when (and gw gw-args)
- (setq login-args (append login-args gw-args)))
-
- ;; Check for port number. Until now, there's no need for handling
- ;; like method, user, host.
- (when (string-match tramp-host-with-port-regexp l-host)
- (setq l-port (match-string 2 l-host)
- l-host (match-string 1 l-host)))
-
- ;; Set variables for computing the prompt for reading password.
- ;; They can also be derived from a gatewy.
- (setq tramp-current-method (or g-method l-method)
- tramp-current-user (or g-user l-user)
- tramp-current-host (or g-host l-host))
-
- ;; Replace login-args place holders.
- (setq
- l-host (or l-host "")
- l-user (or l-user "")
- l-port (or l-port "")
- spec `((?h . ,l-host) (?u . ,l-user) (?p . ,l-port)
- (?t . ,tmpfile))
- command
- (concat
- command " "
- (mapconcat
- '(lambda (x)
- (setq x (mapcar '(lambda (y) (format-spec y spec)) x))
- (unless (member "" x) (mapconcat 'identity x " ")))
- login-args " ")
- ;; String to detect failed connection. Every single word must
- ;; be enclosed with '\"'; otherwise it is detected
- ;; during connection setup.
- ;; Local shell could be a Windows COMSPEC. It doesn't know
- ;; the ";" syntax, but we must exit always for `start-process'.
- ;; "exec" does not work either.
- (if first-hop
- " && exit || exit"
- "; echo \"Tramp\" \"connection\" \"closed\"; sleep 1"))
- ;; We don't reach a Windows shell. Could be initial only.
- first-hop nil)
-
- ;; Send the command.
- (tramp-message vec 3 "Sending command `%s'" command)
- (tramp-send-command vec command t t)
- (tramp-process-actions p vec tramp-actions-before-shell 60)
- (tramp-message vec 3 "Found remote shell prompt on `%s'" l-host))
- ;; Next hop.
- (setq target-alist (cdr target-alist)))
-
- ;; Make initial shell settings.
- (tramp-open-connection-setup-interactive-shell p vec)))))
+ (tramp-message
+ vec 6 "%s" (mapconcat 'identity (process-command p) " "))
+
+ ;; Check whether process is alive.
+ (tramp-set-process-query-on-exit-flag p nil)
+ (tramp-message vec 3 "Waiting 60s for local shell to come up...")
+ (tramp-barf-if-no-shell-prompt
+ p 60 "Couldn't find local shell prompt %s" tramp-encoding-shell)
+
+ ;; Now do all the connections as specified.
+ (while target-alist
+ (let* ((hop (car target-alist))
+ (l-method (tramp-file-name-method hop))
+ (l-user (tramp-file-name-user hop))
+ (l-host (tramp-file-name-host hop))
+ (l-port nil)
+ (login-program
+ (tramp-get-method-parameter l-method 'tramp-login-program))
+ (login-args
+ (tramp-get-method-parameter l-method 'tramp-login-args))
+ (gw-args
+ (tramp-get-method-parameter l-method 'tramp-gw-args))
+ (gw (tramp-get-file-property hop "" "gateway" nil))
+ (g-method (and gw (tramp-file-name-method gw)))
+ (g-user (and gw (tramp-file-name-user gw)))
+ (g-host (and gw (tramp-file-name-host gw)))
+ (command login-program)
+ ;; We don't create the temporary file. In fact, it
+ ;; is just a prefix for the ControlPath option of
+ ;; ssh; the real temporary file has another name, and
+ ;; it is created and protected by ssh. It is also
+ ;; removed by ssh, when the connection is closed.
+ (tmpfile
+ (tramp-set-connection-property
+ p "temp-file"
+ (make-temp-name
+ (expand-file-name
+ tramp-temp-name-prefix
+ (tramp-compat-temporary-file-directory)))))
+ spec)
+
+ ;; Add gateway arguments if necessary.
+ (when (and gw gw-args)
+ (setq login-args (append login-args gw-args)))
+
+ ;; Check for port number. Until now, there's no need
+ ;; for handling like method, user, host.
+ (when (string-match tramp-host-with-port-regexp l-host)
+ (setq l-port (match-string 2 l-host)
+ l-host (match-string 1 l-host)))
+
+ ;; Set variables for computing the prompt for reading
+ ;; password. They can also be derived from a gateway.
+ (setq tramp-current-method (or g-method l-method)
+ tramp-current-user (or g-user l-user)
+ tramp-current-host (or g-host l-host))
+
+ ;; Replace login-args place holders.
+ (setq
+ l-host (or l-host "")
+ l-user (or l-user "")
+ l-port (or l-port "")
+ spec `((?h . ,l-host) (?u . ,l-user) (?p . ,l-port)
+ (?t . ,tmpfile))
+ command
+ (concat
+ command " "
+ (mapconcat
+ '(lambda (x)
+ (setq x (mapcar '(lambda (y) (format-spec y spec)) x))
+ (unless (member "" x) (mapconcat 'identity x " ")))
+ login-args " ")
+ ;; String to detect failed connection. Every single
+ ;; word must be enclosed with '\"'; otherwise it is
+ ;; detected during connection setup.
+ ;; Local shell could be a Windows COMSPEC. It doesn't
+ ;; know the ";" syntax, but we must exit always for
+ ;; `start-process'. "exec" does not work either.
+ (if first-hop
+ " && exit || exit"
+ "; echo \"Tramp\" \"connection\" \"closed\"; sleep 1"))
+ ;; We don't reach a Windows shell. Could be initial only.
+ first-hop nil)
+
+ ;; Send the command.
+ (tramp-message vec 3 "Sending command `%s'" command)
+ (tramp-send-command vec command t t)
+ (tramp-process-actions p vec tramp-actions-before-shell 60)
+ (tramp-message vec 3 "Found remote shell prompt on `%s'" l-host))
+ ;; Next hop.
+ (setq target-alist (cdr target-alist)))
+
+ ;; Make initial shell settings.
+ (tramp-open-connection-setup-interactive-shell p vec))))))
(defun tramp-send-command (vec command &optional neveropen nooutput)
"Send the COMMAND to connection VEC.
(unless (stringp (nth 8 attr))
(setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr))))
;; Convert directory indication bit.
- (if (string-match "^d" (nth 8 attr))
- (setcar attr t)
- (if (and (listp (car attr)) (stringp (caar attr))
+ (when (string-match "^d" (nth 8 attr))
+ (setcar attr t))
+ ;; Convert symlink from `tramp-handle-file-attributes-with-stat'.
+ (when (consp (car attr))
+ (if (and (stringp (caar attr))
(string-match ".+ -> .\\(.+\\)." (caar attr)))
(setcar attr (match-string 1 (caar attr)))
(setcar attr nil)))
(unless (listp (nth 10 attr))
(setcar (nthcdr 10 attr)
(condition-case nil
- (list (floor (nth 10 attr) 65536)
+ (cons (floor (nth 10 attr) 65536)
(floor (mod (nth 10 attr) 65536)))
;; Inodes can be incredible huge. We must hide this.
(error (tramp-get-inode vec)))))
(unless (assoc string tramp-devices)
(add-to-list 'tramp-devices
(list string (length tramp-devices))))
- (list -1 (nth 1 (assoc string tramp-devices)))))
+ (cons -1 (nth 1 (assoc string tramp-devices)))))
(defun tramp-file-mode-from-int (mode)
"Turn an integer representing a file mode into an ls(1)-like string."
(t (concat (tramp-decimal-to-octal (/ i 8))
(number-to-string (% i 8))))))
-
;; Kudos to Gerd Moellmann for this suggestion.
(defun tramp-octal-to-decimal (ostr)
"Given a string of octal digits, return a decimal number."
(let ((result (tramp-find-executable
vec "stat" (tramp-get-remote-path vec)))
tmp)
- ;; Check whether stat(1) returns usable syntax.
+ ;; Check whether stat(1) returns usable syntax. %s does not
+ ;; work on older AIX systems.
(when result
(setq tmp
;; We don't want to display an error message.
(with-temp-message (or (current-message) "")
(condition-case nil
(tramp-send-command-and-read
- vec (format "%s -c '(\"%%N\")' /" result))
+ vec (format "%s -c '(\"%%N\" %%s)' /" result))
(error nil))))
(unless (and (listp tmp) (stringp (car tmp))
- (string-match "^./.$" (car tmp)))
+ (string-match "^./.$" (car tmp))
+ (integerp (cadr tmp)))
(setq result nil)))
result))))
(defun tramp-read-passwd (proc &optional prompt)
"Read a password from user (compat function).
+Consults the auth-source package.
Invokes `password-read' if available, `read-passwd' else."
(let* ((key (tramp-make-tramp-file-name
tramp-current-method tramp-current-user
(with-current-buffer (process-buffer proc)
(tramp-check-for-regexp proc tramp-password-prompt-regexp)
(format "%s for %s " (capitalize (match-string 1)) key)))))
- (if (functionp 'password-read)
- (let ((password (funcall (symbol-function 'password-read)
- pw-prompt key)))
- (funcall (symbol-function 'password-cache-add) key password)
- password)
- (read-passwd pw-prompt))))
+
+ (or
+ ;; See if auth-sources contains something useful, if it's bound.
+ (when (boundp 'auth-sources)
+ ;; Try with Tramp's current method.
+ (funcall (symbol-function 'auth-source-user-or-password)
+ "password" tramp-current-host tramp-current-method))
+ ;; Else, get the password interactively.
+ (if (functionp 'password-read)
+ (let ((password (funcall (symbol-function 'password-read)
+ pw-prompt key)))
+ (funcall (symbol-function 'password-cache-add) key password)
+ password)
+ (read-passwd pw-prompt)))))
(defun tramp-clear-passwd (vec)
"Clear password cache for connection related to VEC."
;; * Autodetect if remote `ls' groks the "--dired" switch.
;; * Rewrite `tramp-shell-quote-argument' to abstain from using
;; `shell-quote-argument'.
-;; * Completion gets confused when you leave out the method name.
;; * In Emacs 21, `insert-directory' shows total number of bytes used
;; by the files in that directory. Add this here.
;; * Avoid screen blanking when hitting `g' in dired. (Eli Tziperman)
;; * When logging in, keep looking for questions according to an alist
;; and then invoke the right function.
;; * Case-insensitive filename completion. (Norbert Goevert.)
-;; * Running CVS remotely doesn't appear to work right. It thinks
-;; files are locked by somebody else even if I'm the locking user.
-;; Sometimes, one gets `No CVSROOT specified' errors from CVS.
-;; (Skip Montanaro)
;; * Don't use globbing for directories with many files, as this is
;; likely to produce long command lines, and some shells choke on
;; long command lines.
;; transfer method to use. (Greg Stark)
;; * Remove unneeded parameters from methods.
;; * Invoke rsync once for copying a whole directory hierarchy.
-;; (Francesco Potortì)
+;; (Francesco Potortì)
;; * Make it work for different encodings, and for different file name
;; encodings, too. (Daniel Pittman)
;; * Progress reports while copying files. (Michael Kifer)
;; * Make `tramp-default-user' obsolete.
;; * Tramp shall reconnect automatically to its ssh connection when it
;; detects that the process "has died". (David Reitter)
+;; * How can I interrupt the remote process with a signal
+;; (interrupt-process seems not to work)? (Markus Triska)
+;; * Avoid the local shell entirely for starting remote processes. If
+;; so, I think even a signal, when delivered directly to the local
+;; SSH instance, would correctly be propagated to the remote process
+;; automatically; possibly SSH would have to be started with
+;; "-t". (Markus Triska)
;; Functions for file-name-handler-alist:
;; diff-latest-backup-file -- in diff.el
;; get-file-buffer -- use primitive
;; vc-registered
-;;; arch-tag: 3a21a994-182b-48fa-b0cd-c1d9fede424a
+;; arch-tag: 3a21a994-182b-48fa-b0cd-c1d9fede424a
;;; tramp.el ends here
+
+;; Local Variables:
+;; mode: Emacs-Lisp
+;; coding: utf-8
+;; End:
HCoop / bpt / emacs.git / blobdiff