X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/4ed774157d1687cc5236ecaf088dc48442e92431..c22c16140eaa4cf391060360d36ab498fa57fdcb:/lisp/net/tramp.el?ds=sidebyside diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index c5d728ba5c..7d88869a0d 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-2013 Free Software Foundation, Inc. +;; Copyright (C) 1998-2014 Free Software Foundation, Inc. ;; Author: Kai Großjohann ;; Michael Albinus @@ -49,9 +49,8 @@ ;; http://lists.gnu.org/mailman/listinfo/tramp-devel ;; ;; For the adventurous, the current development sources are available -;; via CVS. You can find instructions about this at the following URL: +;; via Git. You can find instructions about this at the following URL: ;; http://savannah.gnu.org/projects/tramp/ -;; Click on "CVS" in the navigation bar near the top. ;; ;; Don't forget to put on your asbestos longjohns, first! @@ -66,6 +65,7 @@ (defvar directory-sep-char) (defvar eshell-path-env) (defvar file-notify-descriptors) +(defvar ls-lisp-use-insert-directory-program) (defvar outline-regexp) ;;; User Customizable Internal Variables: @@ -566,11 +566,15 @@ This regexp must match both `tramp-initial-end-of-output' and :type 'regexp) (defcustom tramp-password-prompt-regexp - "^.*\\([pP]assword\\|[pP]assphrase\\).*:\^@? *" + (format "^.*\\(%s\\).*:\^@? *" + (if (boundp 'password-word-equivalents) + (regexp-opt (symbol-value 'password-word-equivalents)) + "password\\|passphrase")) "Regexp matching password-like prompts. The regexp should match at end of buffer. The `sudo' program appears to insert a `^@' character into the prompt." + :version "24.4" :group 'tramp :type 'regexp) @@ -848,7 +852,7 @@ Derived from `tramp-postfix-host-format'.") "\\(?:" "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp "\\)?" "\\(?:" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?" "\\(" "\\(?:" tramp-host-regexp "\\|" - tramp-prefix-ipv6-regexp tramp-ipv6-regexp + tramp-prefix-ipv6-regexp "\\(?:" tramp-ipv6-regexp "\\)?" tramp-postfix-ipv6-regexp "\\)" "\\(?:" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?") "Regular expression matching a Tramp file name between prefix and postfix.") @@ -884,8 +888,8 @@ See also `tramp-file-name-regexp'.") ;;;###autoload (defconst tramp-file-name-regexp-unified (if (memq system-type '(cygwin windows-nt)) - "\\`/\\([^[/|:]\\{2,\\}\\|[^/|]\\{2,\\}]\\):" - "\\`/\\([^[/|:]+\\|[^/|]+]\\):") + "\\`/\\(\\[.*\\]\\|[^/|:]\\{2,\\}[^/|]*\\):" + "\\`/[^/|:][^/|]*:") "Value for `tramp-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. @@ -1433,67 +1437,65 @@ The outline level is equal to the verbosity of the Tramp message." "Append message to debug buffer. Message is formatted with FMT-STRING as control string and the remaining ARGUMENTS to actually emit the message (if applicable)." - (when (get-buffer (tramp-buffer-name vec)) - (with-current-buffer (tramp-get-debug-buffer vec) - (goto-char (point-max)) - ;; Headline. - (when (bobp) - (insert - (format - ";; %sEmacs: %s Tramp: %s -*- mode: outline; -*-" - (if (featurep 'sxemacs) "SX" (if (featurep 'xemacs) "X" "GNU ")) - emacs-version tramp-version))) - (unless (bolp) - (insert "\n")) - ;; Timestamp. - (let ((now (current-time))) - (insert (format-time-string "%T." now)) - (insert (format "%06d " (nth 2 now)))) - ;; Calling Tramp function. We suppress compat and trace - ;; functions from being displayed. - (let ((btn 1) btf fn) - (while (not fn) - (setq btf (nth 1 (backtrace-frame btn))) - (if (not btf) - (setq fn "") - (when (symbolp btf) - (setq fn (symbol-name btf)) - (unless - (and - (string-match "^tramp" fn) - (not - (string-match - (concat - "^" - (regexp-opt - '("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-user-error") - t) - "$") - fn))) - (setq fn nil))) - (setq btn (1+ btn)))) - ;; The following code inserts filename and line number. - ;; Should be inactive by default, because it is time - ;; consuming. -; (let ((ffn (find-function-noselect (intern fn)))) -; (insert -; (format -; "%s:%d: " -; (file-name-nondirectory (buffer-file-name (car ffn))) -; (with-current-buffer (car ffn) -; (1+ (count-lines (point-min) (cdr ffn))))))) - (insert (format "%s " fn))) - ;; The message. - (insert (apply 'format fmt-string arguments))))) + (with-current-buffer (tramp-get-debug-buffer vec) + (goto-char (point-max)) + ;; Headline. + (when (bobp) + (insert + (format + ";; %sEmacs: %s Tramp: %s -*- mode: outline; -*-" + (if (featurep 'sxemacs) "SX" (if (featurep 'xemacs) "X" "GNU ")) + emacs-version tramp-version))) + (unless (bolp) + (insert "\n")) + ;; Timestamp. + (let ((now (current-time))) + (insert (format-time-string "%T." now)) + (insert (format "%06d " (nth 2 now)))) + ;; Calling Tramp function. We suppress compat and trace functions + ;; from being displayed. + (let ((btn 1) btf fn) + (while (not fn) + (setq btf (nth 1 (backtrace-frame btn))) + (if (not btf) + (setq fn "") + (when (symbolp btf) + (setq fn (symbol-name btf)) + (unless + (and + (string-match "^tramp" fn) + (not + (string-match + (concat + "^" + (regexp-opt + '("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-user-error") + t) + "$") + fn))) + (setq fn nil))) + (setq btn (1+ btn)))) + ;; The following code inserts filename and line number. Should + ;; be inactive by default, because it is time consuming. +; (let ((ffn (find-function-noselect (intern fn)))) +; (insert +; (format +; "%s:%d: " +; (file-name-nondirectory (buffer-file-name (car ffn))) +; (with-current-buffer (car ffn) +; (1+ (count-lines (point-min) (cdr ffn))))))) + (insert (format "%s " fn))) + ;; The message. + (insert (apply 'format fmt-string arguments)))) (defvar tramp-message-show-message t "Show Tramp message in the minibuffer. @@ -1530,13 +1532,13 @@ applicable)." arguments)) ;; Log only when there is a minimum level. (when (>= tramp-verbose 4) - (when (and vec-or-proc - (processp vec-or-proc) - (buffer-name (process-buffer vec-or-proc))) - (with-current-buffer (process-buffer vec-or-proc) - ;; Translate proc to vec. - (setq vec-or-proc (tramp-dissect-file-name default-directory)))) - (when (and vec-or-proc (vectorp vec-or-proc)) + ;; Translate proc to vec. + (when (processp vec-or-proc) + (let ((tramp-verbose 0)) + (setq vec-or-proc + (tramp-get-connection-property vec-or-proc "vector" nil)))) + ;; Do it. + (when (vectorp vec-or-proc) (apply 'tramp-debug-message vec-or-proc (concat (format "(%d) # " level) fmt-string) @@ -1548,7 +1550,7 @@ If VEC-OR-PROC is nil, the buffer *debug tramp* is used. This function is meant for debugging purposes." (if vec-or-proc (tramp-message vec-or-proc 10 "\n%s" (with-output-to-string (backtrace))) - (if (<= 10 tramp-verbose) + (if (>= tramp-verbose 10) (with-output-to-temp-buffer "*debug tramp*" (backtrace))))) (defsubst tramp-error (vec-or-proc signal fmt-string &rest arguments) @@ -1821,7 +1823,7 @@ been set up by `rfn-eshadow-setup-minibuffer'." ;; We do not want to send any remote command. (non-essential t)) (when - (file-remote-p + (tramp-tramp-file-p (tramp-compat-funcall 'buffer-substring-no-properties end (point-max))) (save-excursion @@ -2022,8 +2024,8 @@ ARGS are the arguments OPERATION has been called with." 'vm-imap-move-mail 'vm-pop-move-mail 'vm-spool-move-mail)) (save-match-data (cond - ((string-match tramp-file-name-regexp (nth 0 args)) (nth 0 args)) - ((string-match tramp-file-name-regexp (nth 1 args)) (nth 1 args)) + ((tramp-tramp-file-p (nth 0 args)) (nth 0 args)) + ((tramp-tramp-file-p (nth 1 args)) (nth 1 args)) (t (buffer-file-name (current-buffer)))))) ;; START END FILE. ((eq operation 'write-region) @@ -2356,7 +2358,8 @@ not in completion mode." (and (tramp-tramp-file-p filename) (with-parsed-tramp-file-name filename nil (or (not (tramp-completion-mode-p)) - (let ((p (tramp-get-connection-process v))) + (let* ((tramp-verbose 0) + (p (tramp-get-connection-process v))) (and p (processp p) (memq (process-status p) '(run open)))))))) ;; Method, host name and user name completion. @@ -2934,7 +2937,8 @@ User is always nil." (defun tramp-handle-file-remote-p (filename &optional identification connected) "Like `file-remote-p' for Tramp files." - (let ((tramp-verbose 3)) + ;; We do not want traces in the debug buffer. + (let ((tramp-verbose (min tramp-verbose 3))) (when (tramp-tramp-file-p filename) (let* ((v (tramp-dissect-file-name filename)) (p (tramp-get-connection-process v)) @@ -3003,6 +3007,38 @@ User is always nil." (tramp-run-real-handler 'find-backup-file-name (list filename))))) +(defun tramp-handle-insert-directory + (filename switches &optional wildcard full-directory-p) + "Like `insert-directory' for Tramp files." + (unless switches (setq switches "")) + ;; Mark trailing "/". + (when (and (zerop (length (file-name-nondirectory filename))) + (not full-directory-p)) + (setq switches (concat switches "F"))) + (with-parsed-tramp-file-name (expand-file-name filename) nil + (with-tramp-progress-reporter v 0 (format "Opening directory %s" filename) + (require 'ls-lisp) + (let (ls-lisp-use-insert-directory-program start) + (tramp-run-real-handler + 'insert-directory + (list filename switches wildcard full-directory-p)) + ;; `ls-lisp' always returns full listings. We must remove + ;; superfluous parts. + (unless (string-match "l" switches) + (save-excursion + (goto-char (point-min)) + (while (setq start + (text-property-not-all + (point) (point-at-eol) 'dired-filename t)) + (delete-region + start + (or (text-property-any start (point-at-eol) 'dired-filename t) + (point-at-eol))) + (if (= (point-at-bol) (point-at-eol)) + ;; Empty line. + (delete-region (point) (progn (forward-line) (point))) + (forward-line))))))))) + (defun tramp-handle-insert-file-contents (filename &optional visit beg end replace) "Like `insert-file-contents' for Tramp files." @@ -3014,10 +3050,13 @@ User is always nil." v 3 (format "Inserting `%s'" filename) (unwind-protect (if (not (file-exists-p filename)) - ;; We don't raise a Tramp error, because it might be - ;; suppressed, like in `find-file-noselect-1'. - (signal 'file-error - (list "File not found on remote host" filename)) + (progn + ;; We don't raise a Tramp error, because it might be + ;; suppressed, like in `find-file-noselect-1'. + (tramp-message + v 1 "File not `%s' found on remote host" filename) + (signal 'file-error + (list "File not found on remote host" filename))) (if (and (tramp-local-host-p v) (let (file-name-handler-alist) @@ -3141,12 +3180,18 @@ User is always nil." (let ((tramp-message-show-message (not nomessage))) (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 - (load local-copy noerror t t) + (tramp-compat-load local-copy noerror t nosuffix must-suffix) (delete-file local-copy))))) t))) +(defun tramp-handle-make-symbolic-link + (filename linkname &optional ok-if-already-exists) + "Like `make-symbolic-link' for Tramp files." + (with-parsed-tramp-file-name + (if (tramp-tramp-file-p filename) filename linkname) nil + (tramp-error v 'file-error "make-symbolic-link not supported"))) + (defun tramp-handle-shell-command (command &optional output-buffer error-buffer) "Like `shell-command' for Tramp files." @@ -3249,7 +3294,9 @@ User is always nil." ;; "/m:h:~" does not work for completion. We use "/m:h:~/". (when (string-match "~$" filename) (setq filename (concat filename "/")))) - (tramp-run-real-handler 'substitute-in-file-name (list filename)))) + ;; We do not want to replace environment variables, again. + (let (process-environment) + (tramp-run-real-handler 'substitute-in-file-name (list filename))))) (defun tramp-handle-unhandled-file-name-directory (_filename) "Like `unhandled-file-name-directory' for Tramp files." @@ -3351,7 +3398,8 @@ of." (defun tramp-action-password (proc vec) "Query the user for a password." (with-current-buffer (process-buffer proc) - (let ((enable-recursive-minibuffers t)) + (let ((enable-recursive-minibuffers t) + (case-fold-search t)) (tramp-check-for-regexp proc tramp-password-prompt-regexp) (tramp-message vec 3 "Sending %s" (match-string 1)) ;; We don't call `tramp-send-string' in order to hide the @@ -3437,7 +3485,8 @@ The terminal type can be configured with `tramp-terminal-type'." (defun tramp-process-one-action (proc vec actions) "Wait for output from the shell and perform one action." - (let (found todo item pattern action) + (let ((case-fold-search t) + found todo item pattern action) (while (not found) ;; Reread output once all actions have been performed. ;; Obviously, the output was not complete. @@ -3663,8 +3712,8 @@ Example: would yield `t'. On the other hand, the following check results in nil: (tramp-equal-remote \"/sudo::/etc\" \"/su::/etc\")" - (and (stringp (file-remote-p file1)) - (stringp (file-remote-p file2)) + (and (tramp-tramp-file-p file1) + (tramp-tramp-file-p file2) (string-equal (file-remote-p file1) (file-remote-p file2)))) ;;;###tramp-autoload @@ -3812,9 +3861,17 @@ be granted." (or result (let ((file-attr - (tramp-get-file-property - vec (tramp-file-name-localname vec) - (concat "file-attributes-" suffix) nil)) + (or + (tramp-get-file-property + vec (tramp-file-name-localname vec) + (concat "file-attributes-" suffix) nil) + (file-attributes + (tramp-make-tramp-file-name + (tramp-file-name-method vec) + (tramp-file-name-user vec) + (tramp-file-name-host vec) + (tramp-file-name-localname vec)) + (intern suffix)))) (remote-uid (tramp-get-connection-property vec (concat "uid-" suffix) nil)) @@ -4028,7 +4085,7 @@ Lisp error raised when PROGRAM is nil is trapped also, returning 1. Furthermore, traces are written with verbosity of 6." (tramp-message (vector tramp-current-method tramp-current-user tramp-current-host nil nil) - 6 "%s %s %s" program infile args) + 6 "`%s %s' %s" program (mapconcat 'identity args " ") infile) (if (executable-find program) (apply 'call-process program infile destination display args) 1)) @@ -4038,7 +4095,8 @@ Furthermore, traces are written with verbosity of 6." "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 + (let* ((case-fold-search t) + (key (tramp-make-tramp-file-name tramp-current-method tramp-current-user tramp-current-host "")) (pw-prompt @@ -4198,7 +4256,7 @@ Only works for Bourne-like shells." (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) + (if (tramp-tramp-file-p default-directory) (with-parsed-tramp-file-name default-directory nil (mapconcat 'identity @@ -4258,11 +4316,6 @@ Only works for Bourne-like shells." ;; tramp-server-local-variable-alist) to define any such variables ;; that they need to, which would then be let bound as appropriate ;; in tramp functions. (Jason Rumney) -;; * IMHO, it's a drawback that currently Tramp doesn't support -;; Unicode in Dired file names by default. Is it possible to -;; improve Tramp to set LC_ALL to "C" only for commands where Tramp -;; expects English? Or just to set LC_MESSAGES to "C" if Tramp -;; expects only English messages? (Juri Linkov) ;; * Make shadowfile.el grok Tramp filenames. (Bug#4526, Bug#4846) ;; * I was wondering if it would be possible to use tramp even if I'm ;; actually using sshfs. But when I launch a command I would like