X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/8dadeb1e1f78c7be07db5ae78aa9eed58d272a4e..65e86587ab836aaa86b12ce30b219bcb4fcbaa06:/lisp/net/tramp.el diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 2ebc4d0b45..822a995230 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -113,7 +113,7 @@ ;;;###autoload (defvar tramp-unified-filenames (not (featurep 'xemacs)) "Non-nil means to use unified Ange-FTP/Tramp filename syntax. -Nil means to use a separate filename syntax for Tramp.") +Otherwise, use a separate filename syntax for Tramp.") ;; Load foreign methods. Because they do require Tramp internally, this ;; must be done with the `eval-after-load' trick. @@ -149,12 +149,11 @@ Nil means to use a separate filename syntax for Tramp.") (when (featurep 'tramp-smb) (unload-feature 'tramp-smb 'force))))))) -(eval-when-compile - (require 'cl) - (require 'custom) - ;; Emacs 19.34 compatibility hack -- is this needed? - (or (>= emacs-major-version 20) - (load "cl-seq"))) +(require 'cl) +(require 'custom) +;; Emacs 19.34 compatibility hack -- is this needed? +(or (>= emacs-major-version 20) + (load "cl-seq")) (unless (boundp 'custom-print-functions) (defvar custom-print-functions nil)) ; not autoloaded before Emacs 20.4 @@ -473,6 +472,17 @@ This variable defaults to the value of `tramp-encoding-shell'." (tramp-copy-args nil) (tramp-copy-keep-date-arg nil) (tramp-password-end-of-line nil)) + ("scpc" (tramp-connection-function tramp-open-connection-rsh) + (tramp-login-program "ssh") + (tramp-copy-program "scp") + (tramp-remote-sh "/bin/sh") + (tramp-login-args ("-o" "ControlPath=%t.%%r@%%h:%%p" + "-o" "ControlMaster=yes" + "-e" "none")) + (tramp-copy-args ("-o" "ControlPath=%t.%%r@%%h:%%p" + "-o" "ControlMaster=auto")) + (tramp-copy-keep-date-arg "-p") + (tramp-password-end-of-line nil)) ("scpx" (tramp-connection-function tramp-open-connection-rsh) (tramp-login-program "ssh") (tramp-copy-program "scp") @@ -567,6 +577,7 @@ pair of the form (KEY VALUE). The following KEYs are defined: If `tramp-connection-function' is `tramp-open-connection-su', then \"%u\" in this list is replaced by the user name, and \"%%\" can be used to obtain a literal percent character. + \"%t\" is replaced by the temporary file name for `scp'-like methods. * `tramp-copy-program' This specifies the name of the program to use for remotely copying the file; this might be the absolute filename of rcp or the name of @@ -673,10 +684,39 @@ various functions for details." :type '(repeat (list string function string))) (defcustom tramp-default-method - (if (and (fboundp 'executable-find) - (executable-find "plink")) - "plink" - "ssh") + ;; An external copy method seems to be preferred, because it is much + ;; more performant for large files, and it hasn't too serious delays + ;; for small files. But it must be ensured that there aren't + ;; permanent password queries. Either a password agent like + ;; "ssh-agent" or "Pageant" shall run, or the optional password.el + ;; package shall be active for password caching. "scpc" would be + ;; another good choice because of the "ControlMaster" option, but + ;; this is a more modern alternative in OpenSSH 4, which cannot be + ;; taken as default. + (let ((e-f (fboundp 'executable-find))) + (cond + ;; PuTTY is installed. + ((and e-f (funcall 'executable-find "pscp")) + (if (or (fboundp 'password-read) + ;; Pageant is running. + (and (fboundp 'w32-window-exists-p) + (funcall 'w32-window-exists-p "Pageant" "Pageant"))) + "pscp" + "plink")) + ;; There is an ssh installation. + ((and e-f (funcall 'executable-find "scp")) + (if (or (fboundp 'password-read) + ;; ssh-agent is running. + (getenv "SSH_AUTH_SOCK") + (getenv "SSH_AGENT_PID")) + "scp" + "ssh")) + ;; Under Emacs 20, `executable-find' does not exists. So we + ;; couldn't check whether there is an ssh implementation. Let's + ;; hope the best. + ((not e-f) "ssh") + ;; Fallback. + (t "ftp"))) "*Default method to use for transferring files. See `tramp-methods' for possibilities. Also see `tramp-default-method-alist'." @@ -914,8 +954,10 @@ See also `tramp-yn-prompt-regexp'." :type 'regexp) (defcustom tramp-yn-prompt-regexp - (concat (regexp-opt '("Store key in cache? (y/n)") t) - "\\s-*") + (concat + (regexp-opt '("Store key in cache? (y/n)" + "Update cached key? (y/n, Return cancels connection)") t) + "\\s-*") "Regular expression matching all y/n queries which need to be confirmed. The confirmation should be done with y or n. The regexp should match at end of buffer. @@ -944,6 +986,17 @@ be ignored safely." :group 'tramp :type 'regexp) +(defcustom tramp-copy-failed-regexp + (concat "\\(.+: " + (regexp-opt '("Permission denied" + "not a regular file" + "is a directory" + "No such file or directory") t) + "\\)\\s-*") + "Regular expression matching copy problems in (s)cp operations." + :group 'tramp + :type 'regexp) + (defcustom tramp-process-alive-regexp "" "Regular expression indicating a process has finished. @@ -1341,6 +1394,7 @@ corresponding PATTERN matches, the ACTION function is called." (defcustom tramp-actions-copy-out-of-band '((tramp-password-prompt-regexp tramp-action-password) (tramp-wrong-passwd-regexp tramp-action-permission-denied) + (tramp-copy-failed-regexp tramp-action-copy-failed) (tramp-process-alive-regexp tramp-action-out-of-band)) "List of pattern/action pairs. This list is used for copying/renaming with out-of-band methods. @@ -2018,11 +2072,12 @@ If VAR is nil, then we bind `v' to the structure and `multi-method', ,@body)) (put 'with-parsed-tramp-file-name 'lisp-indent-function 2) -;; To be activated for debugging containing this macro -;; It works only when VAR is nil. Otherwise, it can be deactivated by -;; (put 'with-parsed-tramp-file-name 'edebug-form-spec 0) -;; I'm too stupid to write a precise SPEC for it. -(put 'with-parsed-tramp-file-name 'edebug-form-spec t) +;; Enable debugging. +(def-edebug-spec with-parsed-tramp-file-name (form symbolp body)) +;; Highlight as keyword. +(when (functionp 'font-lock-add-keywords) + (funcall 'font-lock-add-keywords + 'emacs-lisp-mode '("\\"))) (defmacro tramp-let-maybe (variable value &rest body) "Let-bind VARIABLE to VALUE in BODY, but only if VARIABLE is not obsolete. @@ -2812,17 +2867,18 @@ of." ;; The following isn't needed for Emacs 20 but for 19.34? -(defun tramp-handle-file-name-completion (filename directory) +(defun tramp-handle-file-name-completion + (filename directory &optional predicate) "Like `file-name-completion' for tramp files." (unless (tramp-tramp-file-p directory) (error "tramp-handle-file-name-completion invoked on non-tramp directory `%s'" directory)) - (with-parsed-tramp-file-name directory nil - (try-completion - filename - (mapcar (lambda (x) (cons x nil)) - (file-name-all-completions filename directory))))) + (try-completion + filename + (mapcar 'list (file-name-all-completions filename directory)) + (when predicate + (lambda (x) (funcall predicate (expand-file-name (car x) directory)))))) ;; cp, mv and ln @@ -2905,7 +2961,7 @@ and `rename'. FILENAME and NEWNAME must be absolute file names." (unless ok-if-already-exists (when (file-exists-p newname) (signal 'file-already-exists - (list newname)))) + (list "File already exists" newname)))) (let ((t1 (tramp-tramp-file-p filename)) (t2 (tramp-tramp-file-p newname)) v1-multi-method v1-method v1-user v1-host v1-localname @@ -2978,10 +3034,10 @@ and `rename'. FILENAME and NEWNAME must be absolute file names." ;; copy-program can be invoked. (if (and (not v1-multi-method) (not v2-multi-method) - (or (tramp-method-out-of-band-p - v1-multi-method v1-method v1-user v1-host) - (tramp-method-out-of-band-p - v2-multi-method v2-method v2-user v2-host))) + (or (and t1 (tramp-method-out-of-band-p + v1-multi-method v1-method v1-user v1-host)) + (and t2 (tramp-method-out-of-band-p + v2-multi-method v2-method v2-user v2-host)))) (tramp-do-copy-or-rename-file-out-of-band op filename newname keep-date) ;; Use the generic method via a Tramp buffer. @@ -3142,6 +3198,14 @@ be a local filename. The method used must be an out-of-band method." v2-user v2-host (tramp-shell-quote-argument v2-localname)))) + ;; Handle ControlMaster/ControlPath + (setq copy-args + (mapcar + (lambda (x) + (format-spec + x `((?t . ,(format "/tmp/%s" tramp-temp-name-prefix))))) + copy-args)) + ;; Handle keep-date argument (when keep-date (if t1 @@ -3176,12 +3240,13 @@ be a local filename. The method used must be an out-of-band method." (message "Transferring %s to %s..." filename newname) ;; Use rcp-like program for file transfer. - (let ((p (apply 'start-process (buffer-name trampbuf) trampbuf - copy-program copy-args))) - (tramp-set-process-query-on-exit-flag p nil) - (tramp-process-actions p multi-method method user host - tramp-actions-copy-out-of-band)) - (kill-buffer trampbuf) + (unwind-protect + (let ((p (apply 'start-process (buffer-name trampbuf) trampbuf + copy-program copy-args))) + (tramp-set-process-query-on-exit-flag p nil) + (tramp-process-actions p multi-method method user host + tramp-actions-copy-out-of-band)) + (kill-buffer trampbuf)) (message "Transferring %s to %s...done" filename newname) ;; Set the mode. @@ -3572,7 +3637,8 @@ This will break if COMMAND prints a newline, followed by the value of ;; for `find-grep-dired' and `find-name-dired' in Emacs 22. (if (tramp-tramp-file-p default-directory) (with-parsed-tramp-file-name default-directory nil - (let ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command)) + (let ((curbuf (current-buffer)) + (asynchronous (string-match "[ \t]*&[ \t]*\\'" command)) status) (unless output-buffer (setq output-buffer @@ -3674,6 +3740,7 @@ This will break if COMMAND prints a newline, followed by the value of (unless (zerop (buffer-size)) (when tramp-display-shell-command-buffer (display-buffer output-buffer))) + (set-buffer curbuf) status)) ;; The following is only executed if something strange was ;; happening. Emit a helpful message and do it anyway. @@ -3886,37 +3953,50 @@ This will break if COMMAND prints a newline, followed by the value of (defun tramp-handle-make-auto-save-file-name () "Like `make-auto-save-file-name' for tramp files. Returns a file name in `tramp-auto-save-directory' for autosaving this file." - (when tramp-auto-save-directory - (unless (file-exists-p tramp-auto-save-directory) - (make-directory tramp-auto-save-directory t))) - ;; jka-compr doesn't like auto-saving, so by appending "~" to the - ;; file name we make sure that jka-compr isn't used for the - ;; auto-save file. - (let ((buffer-file-name - (if tramp-auto-save-directory - (expand-file-name - (tramp-subst-strs-in-string - '(("_" . "|") - ("/" . "_a") - (":" . "_b") - ("|" . "__") - ("[" . "_l") - ("]" . "_r")) - (buffer-file-name)) - tramp-auto-save-directory) - (buffer-file-name)))) - ;; Run plain `make-auto-save-file-name'. There might be an advice when - ;; it is not a magic file name operation (since Emacs 22). - ;; We must deactivate it temporarily. - (if (not (ad-is-active 'make-auto-save-file-name)) - (tramp-run-real-handler - 'make-auto-save-file-name nil) - ;; else - (ad-deactivate 'make-auto-save-file-name) - (prog1 - (tramp-run-real-handler - 'make-auto-save-file-name nil) - (ad-activate 'make-auto-save-file-name))))) + (let ((tramp-auto-save-directory tramp-auto-save-directory)) + ;; File name must be unique. This is ensured with Emacs 22 (see + ;; UNIQUIFY element of `auto-save-file-name-transforms'); but for + ;; all other cases we must do it ourselves. + (when (boundp 'auto-save-file-name-transforms) + (mapcar + '(lambda (x) + (when (and (string-match (car x) buffer-file-name) + (not (car (cddr x)))) + (setq tramp-auto-save-directory + (or tramp-auto-save-directory temporary-file-directory)))) + (symbol-value 'auto-save-file-name-transforms))) + ;; Create directory. + (when tramp-auto-save-directory + (unless (file-exists-p tramp-auto-save-directory) + (make-directory tramp-auto-save-directory t))) + ;; jka-compr doesn't like auto-saving, so by appending "~" to the + ;; file name we make sure that jka-compr isn't used for the + ;; auto-save file. + (let ((buffer-file-name + (if tramp-auto-save-directory + (expand-file-name + (tramp-subst-strs-in-string + '(("_" . "|") + ("/" . "_a") + (":" . "_b") + ("|" . "__") + ("[" . "_l") + ("]" . "_r")) + (buffer-file-name)) + tramp-auto-save-directory) + (buffer-file-name)))) + ;; Run plain `make-auto-save-file-name'. There might be an advice when + ;; it is not a magic file name operation (since Emacs 22). + ;; We must deactivate it temporarily. + (if (not (ad-is-active 'make-auto-save-file-name)) + (tramp-run-real-handler + 'make-auto-save-file-name nil) + ;; else + (ad-deactivate 'make-auto-save-file-name) + (prog1 + (tramp-run-real-handler + 'make-auto-save-file-name nil) + (ad-activate 'make-auto-save-file-name)))))) ;; CCC grok APPEND, LOCKNAME, CONFIRM @@ -4331,7 +4411,12 @@ Falls back to normal file name handler if no tramp file name handler exists." "Add tramp file name handlers to `file-name-handler-alist'." (add-to-list 'file-name-handler-alist (cons tramp-file-name-regexp 'tramp-file-name-handler)) - (when (or partial-completion-mode (featurep 'ido)) + ;; `partial-completion-mode' is unknown in XEmacs. So we should + ;; load it unconditionally there. In the GNU Emacs case, method/ + ;; user/host name completion shall be bound to `partial-completion-mode'. + (when (or (not (boundp 'partial-completion-mode)) + (symbol-value 'partial-completion-mode) + (featurep 'ido)) (add-to-list 'file-name-handler-alist (cons tramp-completion-file-name-regexp 'tramp-completion-file-name-handler)) @@ -4443,7 +4528,6 @@ Falls back to normal file name handler if no tramp file name handler exists." "Checks whether method / user name / host name completion is active." (cond (tramp-completion-mode t) - ((not tramp-unified-filenames) t) ((string-match "^/.*:.*:$" file) nil) ((string-match (concat tramp-prefix-regexp @@ -4452,7 +4536,7 @@ Falls back to normal file name handler if no tramp file name handler exists." (member (match-string 1 file) (mapcar 'car tramp-methods))) ((or (equal last-input-event 'tab) ;; Emacs - (and (integerp last-input-event) + (and (wholenump last-input-event) (or ;; ?\t has event-modifier 'control (char-equal last-input-event ?\t) @@ -4554,10 +4638,14 @@ Falls back to normal file name handler if no tramp file name handler exists." ;; Method, host name and user name completion for a file. ;;;###autoload -(defun tramp-completion-handle-file-name-completion (filename directory) +(defun tramp-completion-handle-file-name-completion + (filename directory &optional predicate) "Like `file-name-completion' for tramp files." - (try-completion filename - (mapcar 'list (file-name-all-completions filename directory)))) + (try-completion + filename + (mapcar 'list (file-name-all-completions filename directory)) + (when predicate + (lambda (x) (funcall predicate (expand-file-name (car x) directory)))))) ;; I misuse a little bit the tramp-file-name structure in order to handle ;; completion possibilities for partial methods / user names / host names. @@ -5017,15 +5105,26 @@ hosts, or files, disagree." (defun tramp-touch (file time) "Set the last-modified timestamp of the given file. TIME is an Emacs internal time value as returned by `current-time'." - (let ((touch-time (format-time-string "%Y%m%d%H%M.%S" time))) + (let* ((utc + ;; With GNU Emacs, `format-time-string' has an optional + ;; parameter UNIVERSAL. This is preferred. + (and (functionp 'subr-arity) + (= 3 (cdr (funcall (symbol-function 'subr-arity) + (symbol-function 'format-time-string)))))) + (touch-time + (if utc + (format-time-string "%Y%m%d%H%M.%S" time t) + (format-time-string "%Y%m%d%H%M.%S" time)))) (if (tramp-tramp-file-p file) (with-parsed-tramp-file-name file nil (let ((buf (tramp-get-buffer multi-method method user host))) (unless (zerop (tramp-send-command-and-check multi-method method user host - (format "touch -t %s %s" + (format "%s touch -t %s %s" + (if utc "TZ=UTC; export TZ;" "") touch-time - localname))) + (tramp-shell-quote-argument localname)) + t)) (pop-to-buffer buf) (error "tramp-touch: touch failed, see buffer `%s' for details" buf)))) @@ -5334,6 +5433,11 @@ Returns nil if none was found, else the command is returned." (kill-process p) (throw 'tramp-action 'permission-denied)) +(defun tramp-action-copy-failed (p multi-method method user host) + "Signal copy failed." + (kill-process p) + (error "%s" (match-string 1))) + (defun tramp-action-yesno (p multi-method method user host) "Ask the user for confirmation using `yes-or-no-p'. Send \"yes\" to remote process on confirmation, abort otherwise. @@ -5390,9 +5494,6 @@ The terminal type can be configured with `tramp-terminal-type'." (tramp-message 10 "'set mode' error ignored.") (tramp-message 9 "Process has finished.") (throw 'tramp-action 'ok)) - (goto-char (point-min)) - (when (re-search-forward "^.cp.?: \\(.+: Permission denied.?\\)$" nil t) - (error "Remote host: %s" (match-string 1))) (tramp-message 9 "Process has died.") (throw 'tramp-action 'process-died))) (t nil))) @@ -5457,6 +5558,7 @@ The terminal type can be configured with `tramp-terminal-type'." (defun tramp-process-actions (p multi-method method user host actions) "Perform actions until success." + (tramp-message 10 "%s" (mapconcat 'identity (process-command p) " ")) (let (exit) (while (not exit) (tramp-message 9 "Waiting for prompts from remote shell") @@ -5627,10 +5729,14 @@ arguments, and xx will be used as the host name to connect to. multi-method (tramp-find-method multi-method method user host) user host 'tramp-login-program)) - (login-args (tramp-get-method-parameter - multi-method - (tramp-find-method multi-method method user host) - user host 'tramp-login-args)) + (login-args (mapcar + (lambda (x) + (format-spec + x `((?t . ,(format "/tmp/%s" tramp-temp-name-prefix))))) + (tramp-get-method-parameter + multi-method + (tramp-find-method multi-method method user host) + user host 'tramp-login-args))) (real-host host)) ;; The following should be changed. We need a more general ;; mechanism to parse extra host args. @@ -6746,8 +6852,8 @@ Return ATTR." ;; Set file's gid change bit. Possible only when id-format is 'integer. (when (numberp (nth 3 attr)) (setcar (nthcdr 9 attr) - (not (= (nth 3 attr) - (tramp-get-remote-gid multi-method method user host))))) + (not (eql (nth 3 attr) + (tramp-get-remote-gid multi-method method user host))))) ;; Set virtual device number. (setcar (nthcdr 11 attr) (tramp-get-device multi-method method user host)) @@ -6884,8 +6990,8 @@ localname (file name on remote host)." item) (while choices (setq item (pop choices)) - (when (and (string-match (nth 0 item) (or host "")) - (string-match (nth 1 item) (or user ""))) + (when (and (string-match (or (nth 0 item) "") (or host "")) + (string-match (or (nth 1 item) "") (or user ""))) (setq method (nth 2 item)) (setq choices nil))) method)) @@ -7197,10 +7303,7 @@ Invokes `password-read' if available, `read-passwd' else." (defun tramp-time-diff (t1 t2) "Return the difference between the two times, in seconds. -T1 and T2 are time values (as returned by `current-time' for example). - -NOTE: This function will fail if the time difference is too large to -fit in an integer." +T1 and T2 are time values (as returned by `current-time' for example)." ;; Pacify byte-compiler with `symbol-function'. (cond ((and (fboundp 'subtract-time) (fboundp 'float-time)) @@ -7211,10 +7314,9 @@ fit in an integer." (funcall (symbol-function 'time-to-seconds) (funcall (symbol-function 'subtract-time) t1 t2))) ((fboundp 'itimer-time-difference) - (floor (funcall - (symbol-function 'itimer-time-difference) - (if (< (length t1) 3) (append t1 '(0)) t1) - (if (< (length t2) 3) (append t2 '(0)) t2)))) + (funcall (symbol-function 'itimer-time-difference) + (if (< (length t1) 3) (append t1 '(0)) t1) + (if (< (length t2) 3) (append t2 '(0)) t2))) (t ;; snarfed from Emacs 21 time-date.el; combining ;; time-to-seconds and subtract-time @@ -7590,6 +7692,7 @@ Therefore, the contents of files might be included in the debug buffer(s).") ;; - Cleanup autoloads ;;;###autoload (defun tramp-unload-tramp () + "Discard Tramp from loading remote files." (interactive) ;; When Tramp is not loaded yet, its autoloads are still active. (tramp-unload-file-name-handlers)