Commit 4efc33f0 authored by Michael Albinus's avatar Michael Albinus

* net/tramp-sh.el (tramp-sh-handle-copy-directory):

* net/tramp-smb.el (tramp-smb-handle-copy-directory):
Handle COPY-CONTENTS.  (Bug#15737)
parent 5d3311e5
2013-10-28 Michael Albinus <michael.albinus@gmx.de>
* 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 <ueno@gnu.org>
* epa-file.el
......
......@@ -1831,18 +1831,20 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
'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 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
'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
......
......@@ -387,141 +387,150 @@ pass to the OPERATION."
(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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment