[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] trunk r114832: * net/tramp-sh.el (tramp-sh-handle-copy-dir
From: |
Michael Albinus |
Subject: |
[Emacs-diffs] trunk r114832: * net/tramp-sh.el (tramp-sh-handle-copy-directory): |
Date: |
Mon, 28 Oct 2013 19:31:06 +0000 |
User-agent: |
Bazaar (2.6b2) |
------------------------------------------------------------
revno: 114832
revision-id: address@hidden
parent: address@hidden
committer: Michael Albinus <address@hidden>
branch nick: trunk
timestamp: Mon 2013-10-28 20:30:40 +0100
message:
* net/tramp-sh.el (tramp-sh-handle-copy-directory):
* net/tramp-smb.el (tramp-smb-handle-copy-directory):
Handle COPY-CONTENTS. (Bug#15737)
modified:
lisp/ChangeLog changelog-20091113204419-o5vbwnq5f7feedwu-1432
lisp/net/tramp-sh.el trampsh.el-20100913133439-a1faifh29eqoi4nh-1
lisp/net/tramp-smb.el
trampsmb.el-20091113204419-o5vbwnq5f7feedwu-2515
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2013-10-28 08:04:48 +0000
+++ b/lisp/ChangeLog 2013-10-28 19:30:40 +0000
@@ -1,3 +1,9 @@
+2013-10-28 Michael Albinus <address@hidden>
+
+ * net/tramp-sh.el (tramp-sh-handle-copy-directory):
+ * net/tramp-smb.el (tramp-smb-handle-copy-directory):
+ Handle COPY-CONTENTS. (Bug#15737)
+
2013-10-28 Daiki Ueno <address@hidden>
* epa-file.el
=== modified file 'lisp/net/tramp-sh.el'
--- a/lisp/net/tramp-sh.el 2013-10-17 19:39:22 +0000
+++ b/lisp/net/tramp-sh.el 2013-10-28 19:30:40 +0000
@@ -1831,18 +1831,20 @@
'copy-file (list filename newname ok-if-already-exists keep-date)))))
(defun tramp-sh-handle-copy-directory
- (dirname newname &optional keep-date parents _copy-contents)
+ (dirname newname &optional keep-date parents copy-contents)
"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)
+ (if (and (not copy-contents)
+ (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
(tramp-file-name-method (tramp-dissect-file-name dirname))
- (tramp-file-name-method (tramp-dissect-file-name
newname)))))
+ (tramp-file-name-method
+ (tramp-dissect-file-name newname)))))
;; scp or rsync DTRT.
(progn
(setq dirname (directory-file-name (expand-file-name dirname))
@@ -1859,7 +1861,10 @@
'copy dirname newname keep-date))
;; We must do it file-wise.
(tramp-run-real-handler
- 'copy-directory (list dirname newname keep-date parents)))
+ 'copy-directory
+ (if copy-contents
+ (list dirname newname keep-date parents copy-contents)
+ (list dirname newname keep-date parents))))
;; When newname did exist, we have wrong cached values.
(when t2
=== modified file 'lisp/net/tramp-smb.el'
--- a/lisp/net/tramp-smb.el 2013-10-18 10:22:02 +0000
+++ b/lisp/net/tramp-smb.el 2013-10-28 19:30:40 +0000
@@ -387,141 +387,150 @@
(throw 'tramp-action 'ok)))))
(defun tramp-smb-handle-copy-directory
- (dirname newname &optional keep-date parents _copy-contents)
+ (dirname newname &optional keep-date parents copy-contents)
"Like `copy-directory' for Tramp files."
- (setq dirname (expand-file-name dirname)
- newname (expand-file-name newname))
- (let ((t1 (tramp-tramp-file-p dirname))
- (t2 (tramp-tramp-file-p newname)))
- (with-parsed-tramp-file-name (if t1 dirname newname) nil
- (with-tramp-progress-reporter
- v 0 (format "Copying %s to %s" dirname newname)
- (cond
- ;; We must use a local temporary directory.
- ((and t1 t2)
- (let ((tmpdir
- (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix
- (tramp-compat-temporary-file-directory)))))
- (unwind-protect
- (progn
- (tramp-compat-copy-directory dirname tmpdir keep-date parents)
- (tramp-compat-copy-directory tmpdir newname keep-date parents))
- (tramp-compat-delete-directory tmpdir 'recursive))))
-
- ;; We can copy recursively.
- ((or t1 t2)
- (when (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 t2 (setq v (tramp-dissect-file-name newname))))
- (if (not (file-directory-p newname))
- (make-directory newname parents))
-
- (setq tramp-current-method (tramp-file-name-method v)
- tramp-current-user (tramp-file-name-user v)
- tramp-current-host (tramp-file-name-real-host v))
-
- (let* ((real-user (tramp-file-name-real-user v))
- (real-host (tramp-file-name-real-host v))
- (domain (tramp-file-name-domain v))
- (port (tramp-file-name-port v))
- (share (tramp-smb-get-share v))
- (localname (file-name-as-directory
- (tramp-compat-replace-regexp-in-string
- "\\\\" "/" (tramp-smb-get-localname v))))
- (tmpdir (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix
- (tramp-compat-temporary-file-directory))))
- (args (list tramp-smb-program
- (concat "//" real-host "/" share) "-E")))
-
- (if (not (zerop (length real-user)))
- (setq args (append args (list "-U" real-user)))
- (setq args (append args (list "-N"))))
-
- (when domain (setq args (append args (list "-W" domain))))
- (when port (setq args (append args (list "-p" port))))
- (when tramp-smb-conf
- (setq args (append args (list "-s" tramp-smb-conf))))
- (setq args
- (if t1
- ;; Source is remote.
- (append args
- (list "-D" (shell-quote-argument localname)
- "-c" (shell-quote-argument "tar qc - *")
- "|" "tar" "xfC" "-"
- (shell-quote-argument tmpdir)))
- ;; Target is remote.
- (append (list "tar" "cfC" "-" (shell-quote-argument dirname)
- "." "|")
- args
- (list "-D" (shell-quote-argument localname)
- "-c" (shell-quote-argument "tar qx -")))))
-
- (unwind-protect
- (with-temp-buffer
- ;; 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))
-
- (when t1
- ;; The smbclient tar command creates always complete
- ;; paths. We must emulate the directory structure,
- ;; and symlink to the real target.
- (make-directory
- (expand-file-name ".." (concat tmpdir localname)) 'parents)
- (make-symbolic-link
- newname (directory-file-name (concat tmpdir localname))))
-
- ;; Use an asynchronous processes. By this, password
- ;; can be handled.
- (let* ((default-directory tmpdir)
- (p (start-process-shell-command
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- (mapconcat 'identity args " "))))
-
- (tramp-message
- v 6 "%s" (mapconcat 'identity (process-command p) " "))
- (tramp-set-connection-property p "vector" v)
- (tramp-compat-set-process-query-on-exit-flag p nil)
- (tramp-process-actions p v nil tramp-smb-actions-with-tar)
-
- (while (memq (process-status p) '(run open))
- (sit-for 0.1))
- (tramp-message v 6 "\n%s" (buffer-string))))
-
- ;; Reset the transfer process properties.
- (tramp-set-connection-property v "process-name" nil)
- (tramp-set-connection-property v "process-buffer" nil)
- (when t1 (delete-directory tmpdir 'recurse))))
-
- ;; Handle KEEP-DATE argument.
- (when keep-date
- (set-file-times newname (nth 5 (file-attributes dirname))))
-
- ;; Set the mode.
- (unless keep-date
- (set-file-modes newname (tramp-default-file-modes dirname)))
-
- ;; When newname did exist, we have wrong cached values.
- (when t2
- (with-parsed-tramp-file-name newname nil
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-file-property v localname))))
-
- ;; We must do it file-wise.
- (t
- (tramp-run-real-handler
- 'copy-directory (list dirname newname keep-date parents))))))))
+ (if copy-contents
+ ;; We must do it file-wise.
+ (tramp-run-real-handler
+ 'copy-directory (list dirname newname keep-date parents copy-contents))
+
+ (setq dirname (expand-file-name dirname)
+ newname (expand-file-name newname))
+ (let ((t1 (tramp-tramp-file-p dirname))
+ (t2 (tramp-tramp-file-p newname)))
+ (with-parsed-tramp-file-name (if t1 dirname newname) nil
+ (with-tramp-progress-reporter
+ v 0 (format "Copying %s to %s" dirname newname)
+ (cond
+ ;; We must use a local temporary directory.
+ ((and t1 t2)
+ (let ((tmpdir
+ (make-temp-name
+ (expand-file-name
+ tramp-temp-name-prefix
+ (tramp-compat-temporary-file-directory)))))
+ (unwind-protect
+ (progn
+ (tramp-compat-copy-directory
+ dirname tmpdir keep-date parents)
+ (tramp-compat-copy-directory
+ tmpdir newname keep-date parents))
+ (tramp-compat-delete-directory tmpdir 'recursive))))
+
+ ;; We can copy recursively.
+ ((or t1 t2)
+ (when (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 t2 (setq v (tramp-dissect-file-name newname))))
+ (if (not (file-directory-p newname))
+ (make-directory newname parents))
+
+ (setq tramp-current-method (tramp-file-name-method v)
+ tramp-current-user (tramp-file-name-user v)
+ tramp-current-host (tramp-file-name-real-host v))
+
+ (let* ((real-user (tramp-file-name-real-user v))
+ (real-host (tramp-file-name-real-host v))
+ (domain (tramp-file-name-domain v))
+ (port (tramp-file-name-port v))
+ (share (tramp-smb-get-share v))
+ (localname (file-name-as-directory
+ (tramp-compat-replace-regexp-in-string
+ "\\\\" "/" (tramp-smb-get-localname v))))
+ (tmpdir (make-temp-name
+ (expand-file-name
+ tramp-temp-name-prefix
+ (tramp-compat-temporary-file-directory))))
+ (args (list tramp-smb-program
+ (concat "//" real-host "/" share) "-E")))
+
+ (if (not (zerop (length real-user)))
+ (setq args (append args (list "-U" real-user)))
+ (setq args (append args (list "-N"))))
+
+ (when domain (setq args (append args (list "-W" domain))))
+ (when port (setq args (append args (list "-p" port))))
+ (when tramp-smb-conf
+ (setq args (append args (list "-s" tramp-smb-conf))))
+ (setq args
+ (if t1
+ ;; Source is remote.
+ (append args
+ (list "-D" (shell-quote-argument localname)
+ "-c" (shell-quote-argument "tar qc - *")
+ "|" "tar" "xfC" "-"
+ (shell-quote-argument tmpdir)))
+ ;; Target is remote.
+ (append (list "tar" "cfC" "-"
+ (shell-quote-argument dirname) "." "|")
+ args
+ (list "-D" (shell-quote-argument localname)
+ "-c" (shell-quote-argument "tar qx -")))))
+
+ (unwind-protect
+ (with-temp-buffer
+ ;; 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))
+
+ (when t1
+ ;; The smbclient tar command creates always
+ ;; complete paths. We must emulate the
+ ;; directory structure, and symlink to the real
+ ;; target.
+ (make-directory
+ (expand-file-name
+ ".." (concat tmpdir localname)) 'parents)
+ (make-symbolic-link
+ newname (directory-file-name (concat tmpdir localname))))
+
+ ;; Use an asynchronous processes. By this,
+ ;; password can be handled.
+ (let* ((default-directory tmpdir)
+ (p (start-process-shell-command
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ (mapconcat 'identity args " "))))
+
+ (tramp-message
+ v 6 "%s" (mapconcat 'identity (process-command p) " "))
+ (tramp-set-connection-property p "vector" v)
+ (tramp-compat-set-process-query-on-exit-flag p nil)
+ (tramp-process-actions p v nil tramp-smb-actions-with-tar)
+
+ (while (memq (process-status p) '(run open))
+ (sit-for 0.1))
+ (tramp-message v 6 "\n%s" (buffer-string))))
+
+ ;; Reset the transfer process properties.
+ (tramp-set-connection-property v "process-name" nil)
+ (tramp-set-connection-property v "process-buffer" nil)
+ (when t1 (delete-directory tmpdir 'recurse))))
+
+ ;; Handle KEEP-DATE argument.
+ (when keep-date
+ (set-file-times newname (nth 5 (file-attributes dirname))))
+
+ ;; Set the mode.
+ (unless keep-date
+ (set-file-modes newname (tramp-default-file-modes dirname)))
+
+ ;; When newname did exist, we have wrong cached values.
+ (when t2
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-file-property v localname))))
+
+ ;; We must do it file-wise.
+ (t
+ (tramp-run-real-handler
+ 'copy-directory (list dirname newname keep-date parents)))))))))
(defun tramp-smb-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] trunk r114832: * net/tramp-sh.el (tramp-sh-handle-copy-directory):,
Michael Albinus <=