diff options
Diffstat (limited to 'lisp/net/tramp-smb.el')
| -rw-r--r-- | lisp/net/tramp-smb.el | 270 |
1 files changed, 134 insertions, 136 deletions
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 434c2bad20d..00b282b83e3 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -334,41 +334,41 @@ KEEP-DATE is not handled in case NEWNAME resides on an SMB server. PRESERVE-UID-GID is completely ignored." (setq filename (expand-file-name filename) newname (expand-file-name newname)) + (with-progress-reporter + (tramp-dissect-file-name (if (file-remote-p filename) filename newname)) + 0 (format "Copying %s to %s" filename newname) + + (let ((tmpfile (file-local-copy filename))) + + (if tmpfile + ;; Remote filename. + (condition-case err + (rename-file tmpfile newname ok-if-already-exists) + ((error quit) + (tramp-compat-delete-file tmpfile 'force) + (signal (car err) (cdr err)))) + + ;; Remote newname. + (when (file-directory-p newname) + (setq newname + (expand-file-name (file-name-nondirectory filename) newname))) + + (with-parsed-tramp-file-name newname nil + (when (and (not ok-if-already-exists) + (file-exists-p newname)) + (tramp-error v 'file-already-exists newname)) - (let ((tmpfile (file-local-copy filename))) - - (if tmpfile - ;; Remote filename. - (condition-case err - (rename-file tmpfile newname ok-if-already-exists) - ((error quit) - (tramp-compat-delete-file tmpfile 'force) - (signal (car err) (cdr err)))) - - ;; Remote newname. - (when (file-directory-p newname) - (setq newname (expand-file-name - (file-name-nondirectory filename) newname))) - - (with-parsed-tramp-file-name newname nil - (when (and (not ok-if-already-exists) - (file-exists-p newname)) - (tramp-error v 'file-already-exists newname)) - - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-property v (file-name-directory localname)) - (tramp-flush-file-property v localname) - (unless (tramp-smb-get-share v) - (tramp-error - v 'file-error "Target `%s' must contain a share name" newname)) - (tramp-message v 0 "Copying file %s to file %s..." filename newname) - (if (tramp-smb-send-command - v (format "put \"%s\" \"%s\"" - filename (tramp-smb-get-localname v))) - (tramp-message - v 0 "Copying file %s to file %s...done" filename newname) - (tramp-error v 'file-error "Cannot copy `%s'" filename))))) + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-file-property v localname) + (unless (tramp-smb-get-share v) + (tramp-error + v 'file-error "Target `%s' must contain a share name" newname)) + (unless (tramp-smb-send-command + v (format "put \"%s\" \"%s\"" + filename (tramp-smb-get-localname v))) + (tramp-error v 'file-error "Cannot copy `%s'" filename)))))) ;; KEEP-DATE handling. (when keep-date (set-file-times newname (nth 5 (file-attributes filename))))) @@ -605,15 +605,15 @@ PRESERVE-UID-GID is completely ignored." v 'file-error "Cannot make local copy of non-existing file `%s'" filename)) (let ((tmpfile (tramp-compat-make-temp-file filename))) - (tramp-message v 4 "Fetching %s to tmp file %s..." filename tmpfile) - (if (tramp-smb-send-command - v (format "get \"%s\" \"%s\"" (tramp-smb-get-localname v) tmpfile)) - (tramp-message - v 4 "Fetching %s to tmp file %s...done" filename tmpfile) - ;; Oops, an error. We shall cleanup. - (tramp-compat-delete-file tmpfile 'force) - (tramp-error - v 'file-error "Cannot make local copy of file `%s'" filename)) + (with-progress-reporter + v 3 (format "Fetching %s to tmp file %s" filename tmpfile) + (unless (tramp-smb-send-command + v (format "get \"%s\" \"%s\"" + (tramp-smb-get-localname v) tmpfile)) + ;; Oops, an error. We shall cleanup. + (tramp-compat-delete-file tmpfile 'force) + (tramp-error + v 'file-error "Cannot make local copy of file `%s'" filename))) tmpfile))) ;; This function should return "foo/" for directories and "bar" for @@ -850,38 +850,39 @@ target of the symlink differ." "Like `rename-file' for Tramp files." (setq filename (expand-file-name filename) newname (expand-file-name newname)) + (with-progress-reporter + (tramp-dissect-file-name (if (file-remote-p filename) filename newname)) + 0 (format "Renaming %s to %s" filename newname) + + (let ((tmpfile (file-local-copy filename))) + + (if tmpfile + ;; Remote filename. + (condition-case err + (rename-file tmpfile newname ok-if-already-exists) + ((error quit) + (tramp-compat-delete-file tmpfile 'force) + (signal (car err) (cdr err)))) + + ;; Remote newname. + (when (file-directory-p newname) + (setq newname (expand-file-name + (file-name-nondirectory filename) newname))) + + (with-parsed-tramp-file-name newname nil + (when (and (not ok-if-already-exists) + (file-exists-p newname)) + (tramp-error v 'file-already-exists newname)) + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-file-property v localname) + (unless (tramp-smb-send-command + v (format "put %s \"%s\"" + filename (tramp-smb-get-localname v))) + (tramp-error v 'file-error "Cannot rename `%s'" filename))))) - (let ((tmpfile (file-local-copy filename))) - - (if tmpfile - ;; Remote filename. - (condition-case err - (rename-file tmpfile newname ok-if-already-exists) - ((error quit) - (tramp-compat-delete-file tmpfile 'force) - (signal (car err) (cdr err)))) - - ;; Remote newname. - (when (file-directory-p newname) - (setq newname (expand-file-name - (file-name-nondirectory filename) newname))) - - (with-parsed-tramp-file-name newname nil - (when (and (not ok-if-already-exists) - (file-exists-p newname)) - (tramp-error v 'file-already-exists newname)) - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-property v (file-name-directory localname)) - (tramp-flush-file-property v localname) - (tramp-message v 0 "Copying file %s to file %s..." filename newname) - (if (tramp-smb-send-command - v (format "put %s \"%s\"" filename (tramp-smb-get-localname v))) - (tramp-message - v 0 "Copying file %s to file %s...done" filename newname) - (tramp-error v 'file-error "Cannot rename `%s'" filename))))) - - (tramp-compat-delete-file filename 'force)) + (tramp-compat-delete-file filename 'force))) (defun tramp-smb-handle-set-file-modes (filename mode) "Like `set-file-modes' for Tramp files." @@ -938,14 +939,14 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." (list start end tmpfile append 'no-message lockname confirm) (list start end tmpfile append 'no-message lockname))) - (tramp-message v 5 "Writing tmp file %s to file %s..." tmpfile filename) - (unwind-protect - (if (tramp-smb-send-command - v (format "put %s \"%s\"" tmpfile (tramp-smb-get-localname v))) - (tramp-message - v 5 "Writing tmp file %s to file %s...done" tmpfile filename) - (tramp-error v 'file-error "Cannot write `%s'" filename)) - (tramp-compat-delete-file tmpfile 'force)) + (with-progress-reporter + v 3 (format "Moving tmp file %s to %s" tmpfile filename) + (unwind-protect + (unless (tramp-smb-send-command + v (format "put %s \"%s\"" + tmpfile (tramp-smb-get-localname v))) + (tramp-error v 'file-error "Cannot write `%s'" filename)) + (tramp-compat-delete-file tmpfile 'force))) (unless (equal curbuf (current-buffer)) (tramp-error @@ -1302,60 +1303,57 @@ connection if a previous connection has died for some reason." (setq args (append args (list "-s" tramp-smb-conf)))) ;; OK, let's go. - (tramp-message - vec 3 "Opening connection for //%s%s/%s..." - (if (not (zerop (length user))) (concat user "@") "") - host (or share "")) - - (let* ((coding-system-for-read nil) - (process-connection-type tramp-process-connection-type) - (p (let ((default-directory - (tramp-compat-temporary-file-directory))) - (apply #'start-process - (tramp-buffer-name vec) (tramp-get-buffer vec) - tramp-smb-program args)))) - - (tramp-message - vec 6 "%s" (mapconcat 'identity (process-command p) " ")) - (tramp-set-process-query-on-exit-flag p nil) - - ;; Set variables for computing the prompt for reading password. - (setq tramp-current-method tramp-smb-method - tramp-current-user user - tramp-current-host host) - - ;; Play login scenario. - (tramp-process-actions - p vec - (if share - tramp-smb-actions-with-share - tramp-smb-actions-without-share)) - - ;; Check server version. - (with-current-buffer (tramp-get-connection-buffer vec) - (goto-char (point-min)) - (search-forward-regexp - "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]" nil t) - (let ((smbserver-version (match-string 0))) - (unless - (string-equal - smbserver-version - (tramp-get-connection-property - vec "smbserver-version" smbserver-version)) - (tramp-flush-directory-property vec "") - (tramp-flush-connection-property vec)) - (tramp-set-connection-property - vec "smbserver-version" smbserver-version))) - - ;; Set chunksize. Otherwise, `tramp-send-string' might - ;; try it itself. - (tramp-set-connection-property p "smb-share" share) - (tramp-set-connection-property p "chunksize" tramp-chunksize) - - (tramp-message - vec 3 "Opening connection for //%s%s/%s...done" - (if (not (zerop (length user))) (concat user "@") "") - host (or share "")))))))) + (with-progress-reporter + vec 3 + (format "Opening connection for //%s%s/%s" + (if (not (zerop (length user))) (concat user "@") "") + host (or share "")) + + (let* ((coding-system-for-read nil) + (process-connection-type tramp-process-connection-type) + (p (let ((default-directory + (tramp-compat-temporary-file-directory))) + (apply #'start-process + (tramp-buffer-name vec) (tramp-get-buffer vec) + tramp-smb-program args)))) + + (tramp-message + vec 6 "%s" (mapconcat 'identity (process-command p) " ")) + (tramp-set-process-query-on-exit-flag p nil) + + ;; Set variables for computing the prompt for reading password. + (setq tramp-current-method tramp-smb-method + tramp-current-user user + tramp-current-host host) + + ;; Play login scenario. + (tramp-process-actions + p vec + (if share + tramp-smb-actions-with-share + tramp-smb-actions-without-share)) + + ;; Check server version. + (with-current-buffer (tramp-get-connection-buffer vec) + (goto-char (point-min)) + (search-forward-regexp + "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]" nil t) + (let ((smbserver-version (match-string 0))) + (unless + (string-equal + smbserver-version + (tramp-get-connection-property + vec "smbserver-version" smbserver-version)) + (tramp-flush-directory-property vec "") + (tramp-flush-connection-property vec)) + (tramp-set-connection-property + vec "smbserver-version" smbserver-version))) + + ;; Set chunksize. Otherwise, `tramp-send-string' might + ;; try it itself. + (tramp-set-connection-property p "smb-share" share) + (tramp-set-connection-property + p "chunksize" tramp-chunksize)))))))) ;; We don't use timeouts. If needed, the caller shall wrap around. (defun tramp-smb-wait-for-output (vec) |