changeset 105462:f6c5cf0fc0c9

* net/tramp.el (tramp-verbose): Fix docstring. (tramp-methods): Add recursive option to `tramp-copy-args'. Add `tramp-copy-recursive'. Valid for "rcp", "scp", "scp1", "scp2", "scp1_old", "scp2_old", "rsync", "rsyncc". (tramp-default-method): Check also for `auth-source-user-or-password'. (tramp-file-name-handler-alist, tramp-file-name-for-operation): Add handler for `copy-directory'. (tramp-handle-copy-directory): New defun. (tramp-do-copy-or-rename-file-out-of-band): Handle directory case. (tramp-handle-start-file-process): Raise an error when PROGRAM is nil. Optimize sent command.
author Michael Albinus <michael.albinus@gmx.de>
date Mon, 05 Oct 2009 11:30:31 +0000
parents c2245b06c9c1
children a6955067f932
files lisp/net/tramp.el
diffstat 1 files changed, 81 insertions(+), 31 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/net/tramp.el	Mon Oct 05 08:45:07 2009 +0000
+++ b/lisp/net/tramp.el	Mon Oct 05 11:30:31 2009 +0000
@@ -187,7 +187,7 @@
   :type 'boolean)
 
 (defcustom tramp-verbose 3
-  "*Verbosity level for Tramp.
+  "*Verbosity level for Tramp messages.
 Any level x includes messages for all levels 1 .. x-1.  The levels are
 
  0  silent (no tramp messages at all)
@@ -203,7 +203,7 @@
   :group 'tramp
   :type 'integer)
 
-;; Emacs case
+;; Emacs case.
 (eval-and-compile
   (when (boundp 'backup-directory-alist)
     (defcustom tramp-backup-directory-alist nil
@@ -302,16 +302,19 @@
              (tramp-login-args           (("%h") ("-l" "%u")))
 	     (tramp-remote-sh            "/bin/sh")
 	     (tramp-copy-program         "rcp")
-	     (tramp-copy-args            (("-p" "%k")))
+	     (tramp-copy-args            (("-p" "%k") ("-r")))
 	     (tramp-copy-keep-date       t)
+	     (tramp-copy-recursive       t)
 	     (tramp-password-end-of-line nil))
     ("scp"   (tramp-login-program        "ssh")
              (tramp-login-args           (("%h") ("-l" "%u") ("-p" "%p") ("-q")
 					  ("-e" "none")))
 	     (tramp-remote-sh            "/bin/sh")
 	     (tramp-copy-program         "scp")
-	     (tramp-copy-args            (("-P" "%p") ("-p" "%k") ("-q")))
+	     (tramp-copy-args            (("-P" "%p") ("-p" "%k")
+					  ("-q") ("-r")))
 	     (tramp-copy-keep-date       t)
+	     (tramp-copy-recursive       t)
 	     (tramp-password-end-of-line nil)
 	     (tramp-gw-args              (("-o"
 					   "GlobalKnownHostsFile=/dev/null")
@@ -324,8 +327,9 @@
 	     (tramp-remote-sh            "/bin/sh")
 	     (tramp-copy-program         "scp")
 	     (tramp-copy-args            (("-1") ("-P" "%p") ("-p" "%k")
-					  ("-q")))
+					  ("-q") ("-r")))
 	     (tramp-copy-keep-date       t)
+	     (tramp-copy-recursive       t)
 	     (tramp-password-end-of-line nil)
 	     (tramp-gw-args              (("-o"
 					   "GlobalKnownHostsFile=/dev/null")
@@ -338,8 +342,9 @@
 	     (tramp-remote-sh            "/bin/sh")
 	     (tramp-copy-program         "scp")
 	     (tramp-copy-args            (("-2") ("-P" "%p") ("-p" "%k")
-					  ("-q")))
+					  ("-q") ("-r")))
 	     (tramp-copy-keep-date       t)
+	     (tramp-copy-recursive       t)
 	     (tramp-password-end-of-line nil)
 	     (tramp-gw-args              (("-o"
 					   "GlobalKnownHostsFile=/dev/null")
@@ -352,8 +357,9 @@
 					  ("-e" "none")))
 	     (tramp-remote-sh            "/bin/sh")
 	     (tramp-copy-program         "scp1")
-	     (tramp-copy-args            (("-p" "%k")))
+	     (tramp-copy-args            (("-p" "%k") ("-r")))
 	     (tramp-copy-keep-date       t)
+	     (tramp-copy-recursive       t)
 	     (tramp-password-end-of-line nil))
     ("scp2_old"
              (tramp-login-program        "ssh2")
@@ -361,8 +367,9 @@
 					  ("-e" "none")))
 	     (tramp-remote-sh            "/bin/sh")
 	     (tramp-copy-program         "scp2")
-	     (tramp-copy-args            (("-p" "%k")))
+	     (tramp-copy-args            (("-p" "%k") ("-r")))
 	     (tramp-copy-keep-date       t)
+	     (tramp-copy-recursive       t)
 	     (tramp-password-end-of-line nil))
     ("sftp"  (tramp-login-program        "ssh")
              (tramp-login-args           (("%h") ("-l" "%u") ("-p" "%p")
@@ -377,23 +384,26 @@
 					  ("-e" "none")))
 	     (tramp-remote-sh            "/bin/sh")
 	     (tramp-copy-program         "rsync")
-	     (tramp-copy-args            (("-e" "ssh") ("-t" "%k")))
+	     (tramp-copy-args            (("-e" "ssh") ("-t" "%k") ("-r")))
 	     (tramp-copy-keep-date       t)
+	     (tramp-copy-recursive       t)
 	     (tramp-password-end-of-line nil))
-    ("rsyncc" (tramp-login-program        "ssh")
+    ("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-args            (("-t" "%k") ("-r")))
 	     (tramp-copy-env             (("RSYNC_RSH")
 					  (,(concat
 					     "ssh"
 					     " -o ControlPath=%t.%%r@%%h:%%p"
 					     " -o ControlMaster=auto"))))
 	     (tramp-copy-keep-date       t)
+	     (tramp-copy-recursive       t)
 	     (tramp-password-end-of-line nil))
     ("remcp" (tramp-login-program        "remsh")
              (tramp-login-args           (("%h") ("-l" "%u")))
@@ -694,15 +704,16 @@
   ;; 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.
+  ;; "ssh-agent" or "Pageant" shall run, or the optional
+  ;; password-cache.el or auth-sources.el packages 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.
   (cond
    ;; PuTTY is installed.
    ((executable-find "pscp")
     (if	(or (fboundp 'password-read)
+	    (fboundp 'auth-source-user-or-password)
 	    ;; Pageant is running.
 	    (tramp-compat-process-running-p "Pageant"))
 	"pscp"
@@ -710,6 +721,7 @@
    ;; There is an ssh installation.
    ((executable-find "scp")
     (if	(or (fboundp 'password-read)
+	    (fboundp 'auth-source-user-or-password)
 	    ;; ssh-agent is running.
 	    (getenv "SSH_AUTH_SOCK")
 	    (getenv "SSH_AGENT_PID"))
@@ -1881,6 +1893,7 @@
     (file-name-completion . tramp-handle-file-name-completion)
     (add-name-to-file . tramp-handle-add-name-to-file)
     (copy-file . tramp-handle-copy-file)
+    (copy-directory . tramp-handle-copy-directory)
     (rename-file . tramp-handle-rename-file)
     (set-file-modes . tramp-handle-set-file-modes)
     (set-file-times . tramp-handle-set-file-times)
@@ -3159,6 +3172,35 @@
     (tramp-run-real-handler
      'copy-file (list filename newname ok-if-already-exists keep-date)))))
 
+(defun tramp-handle-copy-directory (dirname newname &optional keep-date parents)
+  "Like `copy-directory' for Tramp files."
+  (let ((t1 (tramp-tramp-file-p dirname))
+	(t2 (tramp-tramp-file-p newname)))
+    (with-parsed-tramp-file-name (if t1 dirname newname) nil
+      (if (and (tramp-get-method-parameter method 'tramp-copy-recursive)
+	       ;; When DIRNAME and NEWNAME are remote, they must have
+	       ;; the same method.
+	       (or (null t1) (null t2)
+		   (string-equal (file-remote-p dirname 'method)
+				 (file-remote-p newname 'method))))
+	  ;; scp or rsync DTRT.
+	  (progn
+	    (setq dirname (directory-file-name (expand-file-name dirname))
+		  newname (directory-file-name (expand-file-name newname)))
+	    (if (and (file-directory-p newname)
+		     (not (string-equal (file-name-nondirectory dirname)
+					(file-name-nondirectory newname))))
+		(setq newname
+		      (expand-file-name
+		       (file-name-nondirectory dirname) newname)))
+	    (if (not (file-directory-p (file-name-directory newname)))
+		(make-directory (file-name-directory newname) parents))
+	    (tramp-do-copy-or-rename-file-out-of-band
+	     'copy dirname newname keep-date))
+	;; We must do it file-wise.
+	(tramp-run-real-handler
+	 'copy-directory (list dirname newname keep-date parents))))))
+
 (defun tramp-handle-rename-file
   (filename newname &optional ok-if-already-exists)
   "Like `rename-file' for Tramp files."
@@ -3484,7 +3526,14 @@
 
 	;; Check which ones of source and target are Tramp files.
 	(setq source (if t1 (tramp-make-copy-program-file-name v) filename)
-	      target (if t2 (tramp-make-copy-program-file-name v) newname))
+	      target (funcall
+		      (if (and (file-directory-p filename)
+			       (string-equal
+				(file-name-nondirectory filename)
+				(file-name-nondirectory newname)))
+			  'file-name-directory
+			'identity)
+		      (if t2 (tramp-make-copy-program-file-name v) newname)))
 
 	;; Check for port number.  Until now, there's no need for handling
 	;; like method, user, host.
@@ -3950,9 +3999,16 @@
 ;; connection has been setup.
 (defun tramp-handle-start-file-process (name buffer program &rest args)
   "Like `start-file-process' for Tramp files."
+  (unless (stringp program)
+    (tramp-error
+     v 'file-error "pty association is not supported for `%s'" name))
   (with-parsed-tramp-file-name default-directory nil
     (unwind-protect
-	(let ((name1 name)
+	(let ((command (format "cd %s; exec %s"
+			       (tramp-shell-quote-argument localname)
+			       (mapconcat 'tramp-shell-quote-argument
+					  (cons program args) " ")))
+	      (name1 name)
 	      (i 0))
 	  (unless buffer
 	    ;; BUFFER can be nil.  We use a temporary buffer.
@@ -3971,17 +4027,9 @@
 	  (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
+	  ;; Send the command.  `tramp-send-command' opens a new
 	  ;; connection.
-	  (tramp-send-command
-	   v (format "cd %s" (tramp-shell-quote-argument localname)))
-	  ;; Send the command.
-	  (tramp-send-command
-	   v
-	   (format "exec %s"
-		   (mapconcat 'tramp-shell-quote-argument
-			      (cons program args) " "))
-	   nil t) ; nooutput
+	  (tramp-send-command v command nil t) ; nooutput
 	  ;; Set query flag for this process.
 	  (tramp-set-process-query-on-exit-flag
 	   (tramp-get-connection-process v) t)
@@ -4091,6 +4139,7 @@
       (unless ret (setq ret (tramp-send-command-and-check v nil)))
       ;; Provide error file.
       (when tmpstderr (rename-file tmpstderr (cadr destination) t))
+
       ;; Cleanup.  We remove all file cache values for the connection,
       ;; because the remote process could have changed them.
       (when tmpinput (delete-file tmpinput))
@@ -4892,6 +4941,8 @@
 	    (list 'add-name-to-file 'copy-file 'expand-file-name
 		  'file-name-all-completions 'file-name-completion
 		  'file-newer-than-file-p 'make-symbolic-link 'rename-file
+		  ; Emacs 23 only
+		  'copy-directory
 		  ; XEmacs only
 		  'dired-make-relative-symlink
 		  'vm-imap-move-mail 'vm-pop-move-mail 'vm-spool-move-mail))
@@ -6116,7 +6167,7 @@
 
 (defun tramp-process-actions (proc vec actions &optional timeout)
   "Perform actions until success or TIMEOUT."
-  ;; Enable auth-sorce and password-cache.
+  ;; Enable auth-source and password-cache.
   (tramp-set-connection-property proc "first-password-request" t)
   (let (exit)
     (while (not exit)
@@ -8016,8 +8067,6 @@
 ;; * Provide a local cache of old versions of remote files for the rsync
 ;;   transfer method to use.  (Greg Stark)
 ;; * Remove unneeded parameters from methods.
-;; * Invoke rsync once for copying a whole directory hierarchy.
-;;   (Francesco Potortì)
 ;; * Make it work for different encodings, and for different file name
 ;;   encodings, too.  (Daniel Pittman)
 ;; * Progress reports while copying files.  (Michael Kifer)
@@ -8079,6 +8128,7 @@
 ;;   rsync).
 ;; * Keep a second connection open for out-of-band methods like scp or
 ;;   rsync.
+;; * Support ptys in `tramp-handle-start-file-process'.
 
 ;; Functions for file-name-handler-alist:
 ;; diff-latest-backup-file -- in diff.el