Function: tramp-smb-handle-copy-directory

tramp-smb-handle-copy-directory is a byte-compiled function defined in tramp-smb.el.gz.

Signature

(tramp-smb-handle-copy-directory DIRNAME NEWNAME &optional KEEP-DATE PARENTS COPY-CONTENTS)

Documentation

Like copy-directory for Tramp files.

Source Code

;; Defined in /usr/src/emacs/lisp/net/tramp-smb.el.gz
(defun tramp-smb-handle-copy-directory
  (dirname newname &optional keep-date parents copy-contents)
  "Like `copy-directory' for Tramp files."
  (tramp-skeleton-copy-directory
      dirname newname keep-date parents copy-contents
    (let ((t1 (tramp-tramp-file-p dirname))
	  (t2 (tramp-tramp-file-p newname))
	  target)
      (with-parsed-tramp-file-name (if t1 dirname newname) nil
	(unless (file-exists-p dirname)
	  (tramp-error v 'file-missing dirname))

	;; `copy-directory-create-symlink' exists since Emacs 28.1.
	(if (and (bound-and-true-p copy-directory-create-symlink)
		 (setq target (file-symlink-p dirname))
		 (tramp-equal-remote dirname newname))
	    (make-symbolic-link
	     target
	     (if (directory-name-p newname)
		 (concat newname (file-name-nondirectory dirname)) newname)
	     t)

	  (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))
	    (with-tramp-progress-reporter
		v 0 (format "Copying %s to %s" dirname newname)
	      (when (and (file-directory-p newname)
			 (not (directory-name-p newname)))
		(tramp-error v 'file-already-exists newname))
	      (cond
	       ;; We must use a local temporary directory.
	       ((and t1 t2)
		(let ((tmpdir (tramp-compat-make-temp-name)))
		  (unwind-protect
		      (progn
			(make-directory tmpdir)
			(copy-directory
			 dirname (file-name-as-directory tmpdir)
			 keep-date 'parents)
			(copy-directory
			 (expand-file-name
			  (file-name-nondirectory dirname) tmpdir)
			 newname keep-date parents))
		    (delete-directory tmpdir 'recursive))))

	       ;; We can copy recursively.
	       ;; FIXME: Does not work reliably.
	       (nil ;(and (or t1 t2) (tramp-smb-get-cifs-capabilities v))
		(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))

		(let* ((share (tramp-smb-get-share v))
		       (localname (file-name-as-directory
				   (tramp-compat-string-replace
				    "\\" "/" (tramp-smb-get-localname v))))
		       (tmpdir    (tramp-compat-make-temp-name))
		       (args      (list (concat "//" host "/" share) "-E"))
		       (options   tramp-smb-options))

		  (if (tramp-string-empty-or-nil-p user)
		      (setq args (append args (list "-N")))
		    (setq args (append args (list "-U" user))))

		  (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))))
		  (while options
		    (setq args
			  (append args
				  `("--option" ,(format "%s" (car options))))
			  options (cdr options)))
		  (setq args
			(if t1
			    ;; Source is remote.
			    (append args
				    (list "-D"
					  (tramp-unquote-shell-quote-argument
					   localname)
					  "-c"
					  (tramp-unquote-shell-quote-argument
					   "tar qc - *")
					  "|" "tar" "xfC" "-"
					  (tramp-unquote-shell-quote-argument
					   tmpdir)))
			  ;; Target is remote.
			  (append (list
				   "tar" "cfC" "-"
				   (tramp-unquote-shell-quote-argument dirname)
				   "." "|")
				  args
				  (list "-D" (tramp-unquote-shell-quote-argument
					      localname)
					"-c" (tramp-unquote-shell-quote-argument
					      "tar qx -")))))

		  (unwind-protect
		      (with-tramp-saved-connection-properties
			  v '("process-name" "process-buffer")
			(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 (apply
				     #'start-process
				     (tramp-get-connection-name v)
				     (tramp-get-connection-buffer v)
				     tramp-smb-program args)))

			    (tramp-message
			     v 6 "%s" (string-join (process-command p) " "))
			    (process-put p 'tramp-vector v)
			    (process-put
			     p 'adjust-window-size-function #'ignore)
			    (set-process-query-on-exit-flag p nil)
			    (tramp-process-actions
			     p v nil tramp-smb-actions-with-tar)

			    (while (process-live-p p)
			      (sleep-for 0.1))
			    (tramp-message v 6 "\n%s" (buffer-string)))))

		    ;; Save exit.
		    (when t1 (delete-directory tmpdir 'recursive))))

		;; Handle KEEP-DATE argument.
		(when keep-date
		  (tramp-compat-set-file-times
		   newname
		   (file-attribute-modification-time (file-attributes dirname))
		   (unless ok-if-already-exists 'nofollow)))

		;; 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-properties v localname))))

	       ;; We must do it file-wise.
	       (t
		(tramp-run-real-handler
		 #'copy-directory
		 (list dirname newname keep-date parents)))))))))))