changeset 104642:67bdc8713158

* net/tramp.el (tramp-methods): New method "rsyncc". (top): Add completion function for "rsyncc". (tramp-message-show-message): New defvar. (tramp-message, tramp-error): Use it. (tramp-do-copy-or-rename-file-directly): Extend check for direct remote copying. (tramp-do-copy-or-rename-file-out-of-band): Handle new `tramp-methods' entry `copy-env' of "rsyncc". ((tramp-handle-process-file): Do not flush all caches when `process-file-side-effects' is set. tramp-vc-registered-read-file-names): New defconst. (tramp-vc-registered-file-names): New defvar. (tramp-handle-vc-registered): Implement optimization strategy. (tramp-run-real-handler): Add `tramp-vc-file-name-handler'. (tramp-vc-file-name-handler): New defun. (tramp-get-ls-command, tramp-get-test-command) (tramp-get-file-exists-command, tramp-get-remote-ln) (tramp-get-remote-perl, tramp-get-remote-stat) (tramp-get-remote-id): Remove superfluous `with-current-buffer'.

--- a/lisp/net/tramp.el	Thu Aug 27 13:36:19 2009 +0000
+++ b/lisp/net/tramp.el	Thu Aug 27 13:47:55 2009 +0000
@@ -375,6 +375,21 @@
 	     (tramp-copy-args            (("-e" "ssh") ("-t" "%k")))
 	     (tramp-copy-keep-date       t)
 	     (tramp-password-end-of-line nil))
+    ("rsyncc" (tramp-login-program        "ssh")
+             (tramp-login-args           (("%h") ("-l" "%u") ("-p" "%p")
+					  ("-o" "ControlPath=%t.%%r@%%h:%%p")
+					  ("-o" "ControlMaster=yes")
+					  ("-e" "none")))
+	     (tramp-remote-sh            "/bin/sh")
+	     (tramp-copy-program         "rsync")
+	     (tramp-copy-args            (("-t" "%k")))
+	     (tramp-copy-env             (("RSYNC_RSH")
+					  (,(concat
+					     "ssh"
+					     " -o ControlPath=%t.%%r@%%h:%%p"
+					     " -o ControlMaster=auto"))))
+	     (tramp-copy-keep-date       t)
+	     (tramp-password-end-of-line nil))
     ("remcp" (tramp-login-program        "remsh")
              (tramp-login-args           (("%h") ("-l" "%u")))
 	     (tramp-remote-sh            "/bin/sh")
@@ -850,6 +865,8 @@
      (tramp-set-completion-function
       "rsync" tramp-completion-function-alist-ssh)
      (tramp-set-completion-function
+      "rsyncc" tramp-completion-function-alist-ssh)
+     (tramp-set-completion-function
       "remcp" tramp-completion-function-alist-rsh)
      (tramp-set-completion-function
       "rsh" tramp-completion-function-alist-rsh)
@@ -1788,6 +1805,25 @@
 Escape sequence %s is replaced with name of Perl binary.
 This string is passed to `format', so percent characters need to be doubled.")
 
+(defconst tramp-vc-registered-read-file-names
+  "echo \"(\"
+for file in \"$@\"; do
+    if %s $file; then
+	echo \"(\\\"$file\\\" \\\"file-exists-p\\\" t)\"
+    else
+	echo \"(\\\"$file\\\" \\\"file-exists-p\\\" nil)\"
+    fi
+    if %s $file; then
+	echo \"(\\\"$file\\\" \\\"file-readable-p\\\" t)\"
+    else
+	echo \"(\\\"$file\\\" \\\"file-readable-p\\\" nil)\"
+    fi
+done
+echo \")\""
+  "Script to check existence of VC related files.
+It must be send formatted with two strings; the tests for file
+existence, and file readability.")
+
 (defconst tramp-file-mode-type-map
   '((0  . "-")  ; Normal file (SVID-v2 and XPG2)
     (1  . "p")  ; fifo
@@ -1938,6 +1974,11 @@
       ;; The message.
       (insert (apply 'format fmt-string args)))))
 
+(defvar tramp-message-show-message t
+  "Show Tramp message in the minibuffer.
+This variable is used to disable messages from `tramp-error'.
+The messages are visible anyway, because an error is raised.")
+
 (defsubst tramp-message (vec-or-proc level fmt-string &rest args)
   "Emit a message depending on verbosity level.
 VEC-OR-PROC identifies the Tramp buffer to use.  It can be either a
@@ -1956,7 +1997,7 @@
 	;; Match data must be preserved!
 	(save-match-data
 	  ;; Display only when there is a minimum level.
-	  (when (<= level 3)
+	  (when (and tramp-message-show-message (<= level 3))
 	    (apply 'message
 		   (concat
 		    (cond
@@ -1987,11 +2028,14 @@
 VEC-OR-PROC identifies the connection to use, SIGNAL is the
 signal identifier to be raised, remaining args passed to
 `tramp-message'.  Finally, signal SIGNAL is raised."
-  (tramp-message
-   vec-or-proc 1 "%s"
-   (error-message-string
-    (list signal (get signal 'error-message) (apply 'format fmt-string args))))
-  (signal signal (list (apply 'format fmt-string args))))
+  (let (tramp-message-show-message)
+    (tramp-message
+     vec-or-proc 1 "%s"
+     (error-message-string
+      (list signal
+	    (get signal 'error-message)
+	    (apply 'format fmt-string args))))
+    (signal signal (list (apply 'format fmt-string args)))))
 
 (defsubst tramp-error-with-buffer
   (buffer vec-or-proc signal fmt-string &rest args)
@@ -3298,10 +3342,11 @@
 	       'rename-file (list localname1 localname2 ok-if-already-exists))))
 
 	   ;; We can do it directly with `tramp-send-command'
-	   ((let (file-name-handler-alist)
-	      (and (file-readable-p (concat prefix localname1))
-		   (file-writable-p
-		    (file-name-directory (concat prefix localname2)))))
+	   ((and (file-readable-p (concat prefix localname1))
+		 (file-writable-p
+		  (file-name-directory (concat prefix localname2)))
+		 (or (file-directory-p (concat prefix localname2))
+		     (file-writable-p (concat prefix localname2))))
 	    (tramp-do-copy-or-rename-file-directly
 	     op (concat prefix localname1) (concat prefix localname2)
 	     ok-if-already-exists keep-date t)
@@ -3392,7 +3437,7 @@
 The method used must be an out-of-band method."
   (let ((t1 (tramp-tramp-file-p filename))
 	(t2 (tramp-tramp-file-p newname))
-	copy-program copy-args copy-keep-date port spec
+	copy-program copy-args copy-env copy-keep-date port spec
 	source target)
 
     (with-parsed-tramp-file-name (if t1 filename newname) nil
@@ -3445,7 +3490,15 @@
 		    ;; " " is indication for keep-date argument.
 		    (delete " " (mapcar '(lambda (y) (format-spec y spec)) x)))
 		   (unless (member "" x) (mapconcat 'identity x " ")))
-		(tramp-get-method-parameter method 'tramp-copy-args))))
+		(tramp-get-method-parameter method 'tramp-copy-args)))
+	      copy-env
+	      (delq
+	       nil
+	       (mapcar
+		'(lambda (x)
+		   (setq x (mapcar '(lambda (y) (format-spec y spec)) x))
+		   (unless (member "" x) (mapconcat 'identity x " ")))
+		(tramp-get-method-parameter method 'tramp-copy-env))))
 
 	;; Check for program.
 	(when (and (fboundp 'executable-find)
@@ -3459,12 +3512,16 @@
 	    (with-temp-buffer
 	      ;; The default directory must be remote.
 	      (let ((default-directory
-		      (file-name-directory (if t1 filename newname))))
+		      (file-name-directory (if t1 filename newname)))
+		    (process-environment (copy-sequence process-environment)))
 		;; Set the transfer process properties.
 		(tramp-set-connection-property
 		 v "process-name" (buffer-name (current-buffer)))
 		(tramp-set-connection-property
 		 v "process-buffer" (current-buffer))
+		(while copy-env
+		  (tramp-message v 5 "%s=\"%s\"" (car copy-env) (cadr copy-env))
+		  (setenv (pop copy-env) (pop copy-env)))
 
 		;; Use an asynchronous process.  By this, password can
 		;; be handled.  The default directory must be local, in
@@ -4015,7 +4072,15 @@
       ;; Cleanup.  We remove all file cache values for the connection,
       ;; because the remote process could have changed them.
       (when tmpinput (delete-file tmpinput))
-      (tramp-flush-directory-property v "")
+
+      ;; `process-file-side-effects' has been introduced with GNU
+      ;; Emacs 23.2.  If set to `nil', no remote file will be changed
+      ;; by `program'.  If it doesn't exist, we assume its default
+      ;; value 't'.
+      (unless (and (boundp 'process-file-side-effects)
+		   (not (symbol-value 'process-file-side-effects)))
+        (tramp-flush-directory-property v ""))
+
       ;; Return exit status.
       (if (equal ret -1)
 	  (keyboard-quit)
@@ -4664,12 +4729,61 @@
 	  (tramp-message v 0 "Wrote %s" filename))
 	(run-hooks 'tramp-handle-write-region-hook)))))
 
+(defvar tramp-vc-registered-file-names nil
+  "List used to collect file names, which are checked during `vc-registered'.")
+
+;; VC backends check for the existence of various different special
+;; files.  This is very time consuming, because every single check
+;; requires a remote command (the file cache must be invalidated).
+;; Therefore, we apply a kind of optimization.  We install the file
+;; name handler `tramp-vc-file-name-handler', which does nothing but
+;; remembers all file names for which `file-exists-p' or
+;; `file-readable-p' has been applied.  A first run of `vc-registered'
+;; is performed.  Afterwards, a script is applied for all collected
+;; file names, using just one remote command.  The result of this
+;; script is used to fill the file cache with actual values.  Now we
+;; can reset the file name handlers, and we make a second run of
+;; `vc-registered', which returns the expected result without sending
+;; any other remote command.
 (defun tramp-handle-vc-registered (file)
   "Like `vc-registered' for Tramp files."
-  ;; There could be new files, created by the vc backend.  We disable
-  ;; the file cache therefore.
-  (let ((tramp-cache-inhibit-cache t))
-    (tramp-run-real-handler 'vc-registered (list file))))
+  ;; There could be new files, created by the vc backend.  We cannot
+  ;; reuse the old cache entries, therefore.
+  (with-parsed-tramp-file-name file nil
+    (let (tramp-vc-registered-file-names
+	  (tramp-cache-inhibit-cache (current-time))
+	  (file-name-handler-alist
+	   `((,tramp-file-name-regexp . tramp-vc-file-name-handler))))
+
+      ;; Here we collect only file names, which need an operation.
+      (tramp-run-real-handler 'vc-registered (list file))
+      (tramp-message v 10 "\n%s" tramp-vc-registered-file-names)
+
+      ;; Send just one command, in order to fill the cache.
+      (tramp-maybe-send-script
+       v
+       (format tramp-vc-registered-read-file-names
+	       (tramp-get-file-exists-command v)
+	       (format "%s -r" (tramp-get-test-command v)))
+       "tramp_vc_registered_read_file_names")
+
+      (dolist
+	  (elt
+	   (tramp-send-command-and-read
+	    v
+	    (format
+	     "tramp_vc_registered_read_file_names %s"
+	     (mapconcat 'tramp-shell-quote-argument
+			tramp-vc-registered-file-names
+			" "))))
+
+	(tramp-set-file-property v (car elt) (cadr elt)   (cadr (cdr elt)))))
+
+    ;; Second run. Now all requests shall be answered from the file
+    ;; cache.  We unset `process-file-side-effects' in order to keep
+    ;; the cache when `process-file' calls appear.
+    (let (process-file-side-effects)
+      (tramp-run-real-handler 'vc-registered (list file)))))
 
 ;;;###autoload
 (progn (defun tramp-run-real-handler (operation args)
@@ -4678,6 +4792,7 @@
 pass to the OPERATION."
   (let* ((inhibit-file-name-handlers
 	  `(tramp-file-name-handler
+	    tramp-vc-file-name-handler
 	    tramp-completion-file-name-handler
 	    cygwin-mount-name-hook-function
 	    cygwin-mount-map-drive-hook-function
@@ -4881,6 +4996,30 @@
 		  (tramp-run-real-handler operation args))))))
       (setq tramp-locked tl))))
 
+(defun tramp-vc-file-name-handler (operation &rest args)
+  "Invoke special file name handler, which collects files to be handled."
+  (save-match-data
+    (let ((filename
+	   (tramp-replace-environment-variables
+	    (apply 'tramp-file-name-for-operation operation args)))
+	  (fn (assoc operation tramp-file-name-handler-alist)))
+      (with-parsed-tramp-file-name filename nil
+	(cond
+	 ;; That's what we want: file names, for which checks are
+	 ;; applied.  We assume, that VC uses only `file-exists-p' and
+	 ;; `file-readable-p' checks; otherwise we must extend the
+	 ;; list.  We do not perform any action, but return nil, in
+	 ;; order to keep `vc-registered' running.
+	 ((and fn (memq operation '(file-exists-p file-readable-p)))
+	  (add-to-list 'tramp-vc-registered-file-names localname 'append)
+	  nil)
+	 ;; Tramp file name handlers like `expand-file-name'.  They
+	 ;; must still work.
+	 (fn
+	  (save-match-data (apply (cdr fn) args)))
+	 ;; Default file name handlers, we don't care.
+	 (t (tramp-run-real-handler operation args)))))))
+
 ;;;###autoload
 (progn (defun tramp-completion-file-name-handler (operation &rest args)
   "Invoke Tramp file name completion handler.
@@ -7369,24 +7508,19 @@
 
 (defun tramp-get-ls-command (vec)
   (with-connection-property vec "ls"
-    (with-current-buffer (tramp-get-buffer vec)
-      (tramp-message vec 5 "Finding a suitable `ls' command")
-      (or
-       (catch 'ls-found
-	 (dolist (cmd '("ls" "gnuls" "gls"))
-	   (let ((dl (tramp-get-remote-path vec))
-		 result)
-	     (while
-		 (and
-		  dl
-		  (setq result
-			(tramp-find-executable vec cmd dl t t)))
-	       ;; Check parameter.
-	       (when (zerop (tramp-send-command-and-check
-			     vec (format "%s -lnd /" result)))
-		 (throw 'ls-found result))
-	       (setq dl (cdr dl))))))
-       (tramp-error vec 'file-error "Couldn't find a proper `ls' command")))))
+    (tramp-message vec 5 "Finding a suitable `ls' command")
+    (or
+     (catch 'ls-found
+       (dolist (cmd '("ls" "gnuls" "gls"))
+	 (let ((dl (tramp-get-remote-path vec))
+	       result)
+	   (while (and dl (setq result (tramp-find-executable vec cmd dl t t)))
+	     ;; Check parameter.
+	     (when (zerop (tramp-send-command-and-check
+			   vec (format "%s -lnd /" result)))
+	       (throw 'ls-found result))
+	     (setq dl (cdr dl))))))
+     (tramp-error vec 'file-error "Couldn't find a proper `ls' command"))))
 
 (defun tramp-get-ls-command-with-dired (vec)
   (save-match-data
@@ -7397,11 +7531,10 @@
 
 (defun tramp-get-test-command (vec)
   (with-connection-property vec "test"
-    (with-current-buffer (tramp-get-buffer vec)
-      (tramp-message vec 5 "Finding a suitable `test' command")
-      (if (zerop (tramp-send-command-and-check vec "test 0"))
-	  "test"
-	(tramp-find-executable vec "test" (tramp-get-remote-path vec))))))
+    (tramp-message vec 5 "Finding a suitable `test' command")
+    (if (zerop (tramp-send-command-and-check vec "test 0"))
+	"test"
+      (tramp-find-executable vec "test" (tramp-get-remote-path vec)))))
 
 (defun tramp-get-test-nt-command (vec)
   ;; Does `test A -nt B' work?  Use abominable `find' construct if it
@@ -7426,65 +7559,56 @@
 
 (defun tramp-get-file-exists-command (vec)
   (with-connection-property vec "file-exists"
-    (with-current-buffer (tramp-get-buffer vec)
-      (tramp-message vec 5 "Finding command to check if file exists")
-      (tramp-find-file-exists-command vec))))
+    (tramp-message vec 5 "Finding command to check if file exists")
+    (tramp-find-file-exists-command vec)))
 
 (defun tramp-get-remote-ln (vec)
   (with-connection-property vec "ln"
-    (with-current-buffer (tramp-get-buffer vec)
-      (tramp-message vec 5 "Finding a suitable `ln' command")
-      (tramp-find-executable vec "ln" (tramp-get-remote-path vec)))))
+    (tramp-message vec 5 "Finding a suitable `ln' command")
+    (tramp-find-executable vec "ln" (tramp-get-remote-path vec))))
 
 (defun tramp-get-remote-perl (vec)
   (with-connection-property vec "perl"
-    (with-current-buffer (tramp-get-buffer vec)
-      (tramp-message vec 5 "Finding a suitable `perl' command")
-      (or (tramp-find-executable vec "perl5" (tramp-get-remote-path vec))
-	  (tramp-find-executable vec "perl" (tramp-get-remote-path vec))))))
+    (tramp-message vec 5 "Finding a suitable `perl' command")
+    (or (tramp-find-executable vec "perl5" (tramp-get-remote-path vec))
+	(tramp-find-executable vec "perl" (tramp-get-remote-path vec)))))
 
 (defun tramp-get-remote-stat (vec)
   (with-connection-property vec "stat"
-    (with-current-buffer (tramp-get-buffer vec)
-      (tramp-message vec 5 "Finding a suitable `stat' command")
-      (let ((result (tramp-find-executable
-		     vec "stat" (tramp-get-remote-path vec)))
-	    tmp)
-	;; 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\" %%s)' /" result))
-		    (error nil))))
-	  (unless (and (listp tmp) (stringp (car tmp))
-		       (string-match "^./.$" (car tmp))
-		       (integerp (cadr tmp)))
-	    (setq result nil)))
-	result))))
+    (tramp-message vec 5 "Finding a suitable `stat' command")
+    (let ((result (tramp-find-executable
+		   vec "stat" (tramp-get-remote-path vec)))
+	  tmp)
+      ;; 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\" %%s)' /" result))
+		  (error nil))))
+	(unless (and (listp tmp) (stringp (car tmp))
+		     (string-match "^./.$" (car tmp))
+		     (integerp (cadr tmp)))
+	  (setq result nil)))
+      result)))
 
 (defun tramp-get-remote-id (vec)
   (with-connection-property vec "id"
-    (with-current-buffer (tramp-get-buffer vec)
-      (tramp-message vec 5 "Finding POSIX `id' command")
-      (or
-       (catch 'id-found
-	 (let ((dl (tramp-get-remote-path vec))
-	       result)
-	   (while
-	       (and
-		dl
-		(setq result
-		      (tramp-find-executable vec "id" dl t t)))
-	     ;; Check POSIX parameter.
-	     (when (zerop (tramp-send-command-and-check
-			   vec (format "%s -u" result)))
-	       (throw 'id-found result))
-	     (setq dl (cdr dl)))))
-       (tramp-error vec 'file-error "Couldn't find a POSIX `id' command")))))
+    (tramp-message vec 5 "Finding POSIX `id' command")
+    (or
+     (catch 'id-found
+       (let ((dl (tramp-get-remote-path vec))
+	     result)
+	 (while (and dl (setq result (tramp-find-executable vec "id" dl t t)))
+	   ;; Check POSIX parameter.
+	   (when (zerop (tramp-send-command-and-check
+			 vec (format "%s -u" result)))
+	     (throw 'id-found result))
+	   (setq dl (cdr dl)))))
+     (tramp-error vec 'file-error "Couldn't find a POSIX `id' command"))))
 
 (defun tramp-get-remote-uid (vec id-format)
   (with-connection-property vec (format "uid-%s" id-format)
@@ -7939,7 +8063,15 @@
 ;;   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)
-;; * Optimize out-of-band copying, when both methods are scp-like.
+;; * Optimize out-of-band copying, when both methods are scp-like (not
+;;   rsync).
+;; * Keep a second connection open for out-of-band methods like scp or
+;;   rsync.
+;; * Partial completion completes word constituents.  I find it
+;;   acceptable if method completion works only after :, so that we
+;;   have "/s: TAB" offer completion for the method first, filenames
+;;   afterwards. (David Kastrup)
+
 
 ;; Functions for file-name-handler-alist:
 ;; diff-latest-backup-file -- in diff.el