X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/7e570fbf3ef8ccd31df2651f5d2775c5697d5950..36a8b68b3381b77971c0fd655a8e7f41ecc58426:/lisp/net/tramp.el diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index a17bbfa0d1..d959cfc854 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1,6 +1,6 @@ ;;; tramp.el --- Transparent Remote Access, Multiple Protocol -;; Copyright (C) 1998-2012 Free Software Foundation, Inc. +;; Copyright (C) 1998-2013 Free Software Foundation, Inc. ;; Author: Kai Großjohann ;; Michael Albinus @@ -220,7 +220,8 @@ pair of the form (KEY VALUE). The following KEYs are defined: argument. By this, arguments like (\"-l\" \"%u\") are optional. \"%t\" is replaced by the temporary file name produced with `tramp-make-tramp-temp-file'. \"%k\" indicates the keep-date - parameter of a program, if exists. + parameter of a program, if exists. \"%c\" adds additional + `tramp-ssh-controlmaster-options' options for the first hop. * `tramp-async-args' When an asynchronous process is started, we know already that the connection works. Therefore, we can pass additional @@ -280,15 +281,24 @@ started on the local host. You should specify a remote host `localhost' or the name of the local host. Another host name is useful only in combination with `tramp-default-proxies-alist'.") -(defun tramp-detect-ssh-controlmaster () - "Call ssh to detect whether it supports the ControlMaster argument. -This function may return nil when the argument is supported, but -shouldn't return t when it isn't." - (ignore-errors - (with-temp-buffer - (call-process "ssh" nil t nil "-o" "ControlMaster") - (goto-char (point-min)) - (search-forward-regexp "Missing ControlMaster argument" nil t)))) +;;;###tramp-autoload +(defconst tramp-ssh-controlmaster-options + (let ((result "")) + (ignore-errors + (with-temp-buffer + (call-process "ssh" nil t nil "-o" "ControlMaster") + (goto-char (point-min)) + (when (search-forward-regexp "Missing ControlMaster argument" nil t) + (setq result "-o ControlPath=%t.%%r@%%h:%%p -o ControlMaster=auto"))) + (when result + (with-temp-buffer + (call-process "ssh" nil t nil "-o" "ControlPersist") + (goto-char (point-min)) + (when (search-forward-regexp "Missing ControlPersist argument" nil t) + (setq result (concat result " -o ControlPersist=no")))))) + result) + "Call ssh to detect whether it supports the Control* arguments. +Return a string to be used in `tramp-methods'.") (defcustom tramp-default-method ;; An external copy method seems to be preferred, because it performs @@ -297,8 +307,9 @@ shouldn't return t when it isn't." ;; permanent password queries. Either a password agent like ;; "ssh-agent" or "Pageant" shall run, or the optional ;; password-cache.el or auth-sources.el packages shall be active for - ;; password caching. "scpc" is chosen if we detect that the user is - ;; running OpenSSH 4.0 or newer. + ;; password caching. If we detect that the user is running OpenSSH + ;; 4.0 or newer, we could reuse the connection, which calls also for + ;; an external method. (cond ;; PuTTY is installed. We don't take it, if it is installed on a ;; non-windows system, or pscp from the pssh (parallel ssh) package @@ -314,16 +325,16 @@ shouldn't return t when it isn't." "plink")) ;; There is an ssh installation. ((executable-find "scp") - (cond - ((tramp-detect-ssh-controlmaster) "scpc") - ((or (fboundp 'password-read) - (fboundp 'auth-source-user-or-password) - (fboundp 'auth-source-search) - ;; ssh-agent is running. - (getenv "SSH_AUTH_SOCK") - (getenv "SSH_AGENT_PID")) - "scp") - (t "ssh"))) + (if (or (fboundp 'password-read) + (fboundp 'auth-source-user-or-password) + (fboundp 'auth-source-search) + ;; ssh-agent is running. + (getenv "SSH_AUTH_SOCK") + (getenv "SSH_AGENT_PID") + ;; We could reuse the connection. + (> (length tramp-ssh-controlmaster-options) 0)) + "scp" + "ssh")) ;; Fallback. (t "ftp")) "Default method to use for transferring files. @@ -381,6 +392,23 @@ Useful for su and sudo methods mostly." :group 'tramp :type 'string) +;;;###tramp-autoload +(defcustom tramp-default-host-alist nil + "Default host to use for specific method/user pairs. +This is an alist of items (METHOD USER HOST). The first matching item +specifies the host to use for a file name which does not specify a +host. METHOD and HOST are regular expressions or nil, which is +interpreted as a regular expression which always matches. If no entry +matches, the variable `tramp-default-host' takes effect. + +If the file name does not specify the method, lookup is done using the +empty string for the method name." + :group 'tramp + :version "24.4" + :type '(repeat (list (choice :tag "Method regexp" regexp sexp) + (choice :tag " User regexp" regexp sexp) + (choice :tag " Host name" string (const nil))))) + (defcustom tramp-default-proxies-alist nil "Route to be followed for specific host/user pairs. This is an alist of items (HOST USER PROXY). The first matching @@ -403,6 +431,7 @@ interpreted as a regular expression which always matches." (defcustom tramp-save-ad-hoc-proxies nil "Whether to save ad-hoc proxies persistently." :group 'tramp + :version "24.3" :type 'boolean) (defcustom tramp-restricted-shell-hosts-alist @@ -917,7 +946,7 @@ See `tramp-file-name-structure' for more explanations.") This regexp should match partial Tramp file names only. Please note that the entry in `file-name-handler-alist' is made when -this file (tramp.el) is loaded. This means that this variable must be set +this file \(tramp.el\) is loaded. This means that this variable must be set before loading tramp.el. Alternatively, `file-name-handler-alist' can be updated after changing this variable. @@ -1000,11 +1029,25 @@ this variable to be set as well." ;; for an override of the system default. (defcustom tramp-process-connection-type t "Overrides `process-connection-type' for connections from Tramp. -Tramp binds process-connection-type to the value given here before +Tramp binds `process-connection-type' to the value given here before opening a connection to a remote host." :group 'tramp :type '(choice (const nil) (const t) (const pty))) +(defcustom tramp-connection-min-time-diff 5 + "Defines seconds between two consecutive connection attempts. +This is necessary as self defense mechanism, in order to avoid +yo-yo connection attempts when the remote host is unavailable. + +A value of 0 or `nil' suppresses this check. This might be +necessary, when several out-of-order copy operations are +performed, or when several asynchronous processes will be started +in a short time frame. In those cases it is recommended to +let-bind this variable." + :group 'tramp + :version "24.4" + :type '(choice (const nil) integer)) + (defcustom tramp-completion-reread-directory-timeout 10 "Defines seconds since last remote command before rereading a directory. A remote directory might have changed its contents. In order to @@ -1015,7 +1058,7 @@ have been gone since last remote command execution. A value of `t' would require an immediate reread during filename completion, `nil' means to use always cached values for the directory contents." :group 'tramp - :type '(choice (const nil) integer)) + :type '(choice (const nil) (const t) integer)) ;;; Internal Variables: @@ -1124,23 +1167,48 @@ If the `tramp-methods' entry does not exist, return nil." (defun tramp-tramp-file-p (name) "Return t if NAME is a string with Tramp file name syntax." (save-match-data - (and (stringp name) (string-match tramp-file-name-regexp name)))) + (and (stringp name) + (string-match tramp-file-name-regexp name)))) + +;; Obsoleted with Tramp 2.2.7. +(defconst tramp-obsolete-methods + '("ssh1" "ssh2" "scp1" "scp2" "scpc" "rsyncc" "plink1") + "Obsolete methods.") + +(defvar tramp-warned-obsolete-methods nil + "Which methods the user has been warned to be obsolete.") (defun tramp-find-method (method user host) "Return the right method string to use. This is METHOD, if non-nil. Otherwise, do a lookup in -`tramp-default-method-alist'." - (or method - (let ((choices tramp-default-method-alist) - lmethod item) - (while choices - (setq item (pop choices)) - (when (and (string-match (or (nth 0 item) "") (or host "")) - (string-match (or (nth 1 item) "") (or user ""))) - (setq lmethod (nth 2 item)) - (setq choices nil))) - lmethod) - tramp-default-method)) +`tramp-default-method-alist'. It maps also obsolete methods to +their replacement." + (let ((result + (or method + (let ((choices tramp-default-method-alist) + lmethod item) + (while choices + (setq item (pop choices)) + (when (and (string-match (or (nth 0 item) "") (or host "")) + (string-match (or (nth 1 item) "") (or user ""))) + (setq lmethod (nth 2 item)) + (setq choices nil))) + lmethod) + tramp-default-method))) + ;; This is needed for a transition period only. + (when (member result tramp-obsolete-methods) + (unless (member result tramp-warned-obsolete-methods) + (if noninteractive + (warn "Method %s is obsolete, using %s" + result (substring result 0 -1)) + (unless (y-or-n-p (format "Method %s is obsolete, use %s? " + result (substring result 0 -1))) + (error 'file-error "Method \"%s\" not supported" result))) + (add-to-list 'tramp-warned-obsolete-methods result)) + ;; This works with the current set of `tramp-obsolete-methods'. + ;; Must be improved, if their are more sophisticated replacements. + (setq result (substring result 0 -1))) + result)) (defun tramp-find-user (method user host) "Return the right user string to use. @@ -1162,6 +1230,15 @@ This is USER, if non-nil. Otherwise, do a lookup in "Return the right host string to use. This is HOST, if non-nil. Otherwise, it is `tramp-default-host'." (or (and (> (length host) 0) host) + (let ((choices tramp-default-host-alist) + lhost item) + (while choices + (setq item (pop choices)) + (when (and (string-match (or (nth 0 item) "") (or method "")) + (string-match (or (nth 1 item) "") (or user ""))) + (setq lhost (nth 2 item)) + (setq choices nil))) + lhost) tramp-default-host)) (defun tramp-dissect-file-name (name &optional nodefault) @@ -1298,6 +1375,8 @@ The outline level is equal to the verbosity of the Tramp message." (get-buffer-create (tramp-debug-buffer-name vec)) (when (bobp) (setq buffer-undo-list t) + ;; So it does not get loaded while `outline-regexp' is let-bound. + (require 'outline) ;; Activate `outline-mode'. This runs `text-mode-hook' and ;; `outline-mode-hook'. We must prevent that local processes ;; die. Yes: I've seen `flyspell-mode', which starts "ispell". @@ -1347,13 +1426,15 @@ ARGS to actually emit the message (if applicable)." (concat "^" (regexp-opt - '("tramp-compat-funcall" + '("tramp-backtrace" + "tramp-compat-condition-case-unless-debug" + "tramp-compat-funcall" "tramp-compat-with-temp-message" + "tramp-condition-case-unless-debug" "tramp-debug-message" "tramp-error" "tramp-error-with-buffer" - "tramp-message" - "tramp-with-progress-reporter") + "tramp-message") t) "$") fn))) @@ -1455,8 +1536,18 @@ an input event arrives. The other arguments are passed to `tramp-error'." (or (and (bufferp buffer) buffer) (and (processp vec-or-proc) (process-buffer vec-or-proc)) (tramp-get-connection-buffer vec-or-proc))) + (when (string-equal fmt-string "Process died") + (message + "%s\n %s" + "Tramp failed to connect. If this happens repeatedly, try" + "`M-x tramp-cleanup-this-connection'")) (sit-for 30)))))) +(defsubst tramp-backtrace (vec-or-proc) + "Dump a backtrace into the debug buffer. +This function is meant for debugging purposes." + (tramp-message vec-or-proc 10 "\n%s" (with-output-to-string (backtrace)))) + (defmacro with-parsed-tramp-file-name (filename var &rest body) "Parse a Tramp filename and make components available in the body. @@ -1497,7 +1588,7 @@ If VAR is nil, then we bind `v' to the structure and `method', `user', (when (string-match message (or (current-message) "")) (tramp-compat-funcall 'progress-reporter-update reporter value)))) -(defmacro tramp-with-progress-reporter (vec level message &rest body) +(defmacro with-tramp-progress-reporter (vec level message &rest body) "Executes BODY, spinning a progress reporter with MESSAGE. If LEVEL does not fit for visible messages, or if this is a nested call of the macro, there are only traces without a visible @@ -1526,7 +1617,42 @@ progress reporter." (tramp-message ,vec ,level "%s...done" ,message)))) (tramp-compat-font-lock-add-keywords - 'emacs-lisp-mode '("\\")) + 'emacs-lisp-mode '("\\")) + +(defmacro with-tramp-file-property (vec file property &rest body) + "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache. +FILE must be a local file name on a connection identified via VEC." + `(if (file-name-absolute-p ,file) + (let ((value (tramp-get-file-property ,vec ,file ,property 'undef))) + (when (eq value 'undef) + ;; We cannot pass @body as parameter to + ;; `tramp-set-file-property' because it mangles our + ;; debug messages. + (setq value (progn ,@body)) + (tramp-set-file-property ,vec ,file ,property value)) + value) + ,@body)) + +(put 'with-tramp-file-property 'lisp-indent-function 3) +(put 'with-tramp-file-property 'edebug-form-spec t) +(tramp-compat-font-lock-add-keywords + 'emacs-lisp-mode '("\\")) + +(defmacro with-tramp-connection-property (key property &rest body) + "Check in Tramp for property PROPERTY, otherwise executes BODY and set." + `(let ((value (tramp-get-connection-property ,key ,property 'undef))) + (when (eq value 'undef) + ;; We cannot pass ,@body as parameter to + ;; `tramp-set-connection-property' because it mangles our debug + ;; messages. + (setq value (progn ,@body)) + (tramp-set-connection-property ,key ,property value)) + value)) + +(put 'with-tramp-connection-property 'lisp-indent-function 2) +(put 'with-tramp-connection-property 'edebug-form-spec t) +(tramp-compat-font-lock-add-keywords + 'emacs-lisp-mode '("\\")) (defalias 'tramp-drop-volume-letter (if (memq system-type '(cygwin windows-nt)) @@ -1714,19 +1840,22 @@ value of `default-file-modes', without execute permissions." (logand (default-file-modes) (tramp-compat-octal-to-decimal "0666")))) (defun tramp-replace-environment-variables (filename) - "Replace environment variables in 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))))) - (getenv (match-string 1 filename))) - (setq filename - (replace-match - (substitute-in-file-name (match-string 0 filename)) - t nil filename))) - filename))) + (or (ignore-errors + (tramp-compat-funcall 'substitute-env-vars filename 'only-defined)) + ;; We need an own implementation. + (save-match-data + (let ((idx (string-match "$\\(\\w+\\)" filename))) + ;; `$' is coded as `$$'. + (when (and idx + (or (zerop idx) (not (eq ?$ (aref filename (1- idx))))) + (getenv (match-string 1 filename))) + (setq filename + (replace-match + (substitute-in-file-name (match-string 0 filename)) + t nil filename))) + filename)))) ;; In XEmacs, electricity is implemented via a key map for ?/ and ?~, ;; which calls corresponding functions (see minibuf.el). @@ -1836,7 +1965,8 @@ ARGS are the arguments OPERATION has been called with." ;; Emacs 22+ only. 'set-file-times ;; Emacs 24+ only. - 'file-selinux-context 'set-file-selinux-context + 'file-acl 'file-selinux-context + 'set-file-acl 'set-file-selinux-context ;; XEmacs only. 'abbreviate-file-name 'create-file-buffer 'dired-file-modtime 'dired-make-compressed-filename @@ -1887,10 +2017,7 @@ ARGS are the arguments OPERATION has been called with." ;; Emacs 23+ only. 'start-file-process ;; XEmacs only. - 'dired-print-file 'dired-shell-call-process - ;; nowhere yet. - 'executable-find 'start-process - 'call-process 'call-process-region)) + 'dired-print-file 'dired-shell-call-process)) default-directory) ;; Unknown file primitive. (t (error "unknown file I/O primitive: %s" operation)))) @@ -1916,6 +2043,15 @@ ARGS are the arguments OPERATION has been called with." res (cdr elt)))) res)))) +(defvar tramp-debug-on-error nil + "Like `debug-on-error' but used Tramp internal.") + +(defmacro tramp-condition-case-unless-debug + (var bodyform &rest handlers) + "Like `condition-case-unless-debug' but `tramp-debug-on-error'." + `(let ((debug-on-error tramp-debug-on-error)) + (tramp-compat-condition-case-unless-debug ,var ,bodyform ,@handlers))) + ;; Main function. ;;;###autoload (defun tramp-file-name-handler (operation &rest args) @@ -1931,7 +2067,7 @@ Falls back to normal file name handler if no Tramp file name handler exists." (with-parsed-tramp-file-name filename nil ;; Call the backend function. (if foreign - (tramp-compat-condition-case-unless-debug err + (tramp-condition-case-unless-debug err (let ((sf (symbol-function foreign)) result) ;; Some packages set the default directory to a @@ -1984,7 +2120,7 @@ Falls back to normal file name handler if no Tramp file name handler exists." ;; in order to give the user a chance to correct the ;; file name in the minibuffer. ;; In order to get a full backtrace, one could apply - ;; (setq debug-on-error t debug-on-signal t) + ;; (setq tramp-debug-on-error t) (error (cond ((and completion (zerop (length localname)) @@ -2711,6 +2847,11 @@ User is always nil." (if (or dir-p (file-directory-p dir)) dir (file-name-directory dir)) nil (tramp-flush-directory-property v localname))) +(defun tramp-handle-file-accessible-directory-p (filename) + "Like `file-accessible-directory-p' for Tramp files." + (and (file-directory-p filename) + (file-executable-p filename))) + (defun tramp-handle-file-exists-p (filename) "Like `file-exists-p' for Tramp files." (not (null (file-attributes filename)))) @@ -2859,7 +3000,7 @@ User is always nil." (setq filename (expand-file-name filename)) (let (result local-copy remote-copy) (with-parsed-tramp-file-name filename nil - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 3 (format "Inserting `%s'" filename) (unwind-protect (if (not (file-exists-p filename)) @@ -2934,13 +3075,15 @@ User is always nil." (setq tramp-temp-buffer-file-name local-copy)) ;; We must ensure that `file-coding-system-alist' - ;; matches `local-copy'. + ;; matches `local-copy'. We must also use `visit', + ;; otherwise there might be an error in the + ;; `revert-buffer' function under XEmacs. (let ((file-coding-system-alist (tramp-find-file-name-coding-system-alist filename local-copy))) (setq result (insert-file-contents - local-copy nil nil nil replace))))) + local-copy visit nil nil replace))))) ;; Save exit. (progn @@ -2982,7 +3125,7 @@ User is always nil." (if (not (file-exists-p file)) nil (let ((tramp-message-show-message (not nomessage))) - (tramp-with-progress-reporter v 0 (format "Loading %s" file) + (with-tramp-progress-reporter v 0 (format "Loading %s" file) (let ((local-copy (file-local-copy file))) ;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil. (unwind-protect @@ -3126,7 +3269,7 @@ beginning of local filename are not substituted." "Send the login name." (when (not (stringp tramp-current-user)) (setq tramp-current-user - (with-connection-property vec "login-as" + (with-tramp-connection-property vec "login-as" (save-window-excursion (let ((enable-recursive-minibuffers t)) (pop-to-buffer (tramp-get-connection-buffer vec)) @@ -3293,7 +3436,9 @@ for process communication also." ;; Under Windows XP, accept-process-output doesn't return ;; sometimes. So we add an additional timeout. (with-timeout ((or timeout 1)) - (accept-process-output proc timeout timeout-msecs (and proc t)))) + (if (featurep 'xemacs) + (accept-process-output proc timeout timeout-msecs) + (accept-process-output proc timeout timeout-msecs (and proc t))))) (tramp-message proc 10 "\n%s" (buffer-string)))) (defun tramp-check-for-regexp (proc regexp) @@ -3322,7 +3467,9 @@ Erase echoed commands if exists." 0 (min tramp-echo-mark-marker-length (1- (point-max)))) (tramp-compat-funcall 'buffer-substring-no-properties - 1 (min (1+ tramp-echo-mark-marker-length) (point-max)))))) + (point-min) + (min (+ (point-min) tramp-echo-mark-marker-length) + (point-max)))))) ;; No echo to be handled, now we can look for the regexp. ;; Sometimes, lines are much to long, and we run into a "Stack ;; overflow in regexp matcher". For example, //DIRED// lines of @@ -3414,13 +3561,13 @@ the remote host use line-endings as defined in the variable (defun tramp-get-inode (vec) "Returns the virtual inode number. If it doesn't exist, generate a new one." - (with-file-property vec (tramp-file-name-localname vec) "inode" + (with-tramp-file-property vec (tramp-file-name-localname vec) "inode" (setq tramp-inodes (1+ tramp-inodes)))) (defun tramp-get-device (vec) "Returns the virtual device number. If it doesn't exist, generate a new one." - (with-connection-property (tramp-get-connection-process vec) "device" + (with-tramp-connection-property (tramp-get-connection-process vec) "device" (cons -1 (setq tramp-devices (1+ tramp-devices))))) (defun tramp-equal-remote (file1 file2) @@ -3542,7 +3689,7 @@ would yield `t'. On the other hand, the following check results in nil: (defun tramp-get-remote-tmpdir (vec) "Return directory for temporary files on the remote host identified by VEC." - (with-connection-property vec "tmpdir" + (with-tramp-connection-property vec "tmpdir" (let ((dir (tramp-make-tramp-file-name (tramp-file-name-method vec) (tramp-file-name-user vec) @@ -3724,6 +3871,7 @@ Invokes `password-read' if available, `read-passwd' else." ("oct" . 10) ("nov" . 11) ("dec" . 12)) "Alist mapping month names to integers.") +;; FIXME: Shouldn't this also look at any subseconds parts of T1 and T2? ;;;###tramp-autoload (defun tramp-time-less-p (t1 t2) "Say whether time value T1 is less than time value T2." @@ -3733,6 +3881,7 @@ Invokes `password-read' if available, `read-passwd' else." (and (= (car t1) (car t2)) (< (nth 1 t1) (nth 1 t2))))) +;; FIXME: Shouldn't this also look at any subseconds parts of T1 and T2? (defun tramp-time-subtract (t1 t2) "Subtract two time values. Return the difference in the format of a time value." @@ -3806,6 +3955,39 @@ Only works for Bourne-like shells." t t result))) result)))) +;;; Integration of eshell.el: + +(eval-when-compile + (defvar eshell-path-env)) + +;; eshell.el keeps the path in `eshell-path-env'. We must change it +;; when `default-directory' points to another host. +(defun tramp-eshell-directory-change () + "Set `eshell-path-env' to $PATH of the host related to `default-directory'." + (setq eshell-path-env + (if (file-remote-p default-directory) + (with-parsed-tramp-file-name default-directory nil + (mapconcat + 'identity + (or + ;; When `tramp-own-remote-path' is in `tramp-remote-path', + ;; the remote path is only set in the session cache. + (tramp-get-connection-property + (tramp-get-connection-process v) "remote-path" nil) + (tramp-get-connection-property v "remote-path" nil)) + ":")) + (getenv "PATH")))) + +(eval-after-load "esh-util" + '(progn + (tramp-eshell-directory-change) + (add-hook 'eshell-directory-change-hook + 'tramp-eshell-directory-change) + (add-hook 'tramp-unload-hook + (lambda () + (remove-hook 'eshell-directory-change-hook + 'tramp-eshell-directory-change))))) + ;; Checklist for `tramp-unload-hook' ;; - Unload all `tramp-*' packages ;; - Reset `file-name-handler-alist' @@ -3830,7 +4012,6 @@ Only works for Bourne-like shells." ;; * 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) -;; * Make ffap.el grok Tramp filenames. (Eli Tziperman) ;; * abbreviate-file-name ;; * Better error checking. At least whenever we see something ;; strange when doing zerop, we should kill the process and start