Mercurial > emacs
comparison lisp/net/tramp-smb.el @ 105524:e781cac84553
* net/tramp-smb.el (tramp-smb-handle-copy-directory): Handle the
case both directories are remote.
(tramp-smb-handle-expand-file-name): Implement "~" expansion.
(tramp-smb-maybe-open-connection): Flush the cache only if
necessary.
| author | Michael Albinus <michael.albinus@gmx.de> |
|---|---|
| date | Thu, 08 Oct 2009 15:21:19 +0000 |
| parents | 69bf209a4707 |
| children | 2025d7d04cb9 |
comparison
equal
deleted
inserted
replaced
| 105523:54704a452681 | 105524:e781cac84553 |
|---|---|
| 216 (setq dirname (expand-file-name dirname) | 216 (setq dirname (expand-file-name dirname) |
| 217 newname (expand-file-name newname)) | 217 newname (expand-file-name newname)) |
| 218 (let ((t1 (tramp-tramp-file-p dirname)) | 218 (let ((t1 (tramp-tramp-file-p dirname)) |
| 219 (t2 (tramp-tramp-file-p newname))) | 219 (t2 (tramp-tramp-file-p newname))) |
| 220 (with-parsed-tramp-file-name (if t1 dirname newname) nil | 220 (with-parsed-tramp-file-name (if t1 dirname newname) nil |
| 221 (if (or (null t1) (null t2)) | 221 (cond |
| 222 ;; We can copy recursively. | 222 ((and t1 t2) |
| 223 (let ((prompt (tramp-smb-send-command v "prompt")) | 223 ;; We must copy, using a local temporary directory. |
| 224 (recurse (tramp-smb-send-command v "recurse"))) | 224 (let ((tmpdir |
| 225 (unless (file-directory-p newname) | 225 (make-temp-name |
| 226 (make-directory newname parents)) | 226 (expand-file-name |
| 227 (unwind-protect | 227 tramp-temp-name-prefix |
| 228 (unless | 228 (tramp-compat-temporary-file-directory))))) |
| 229 (and | 229 (unwind-protect |
| 230 prompt recurse | 230 (progn |
| 231 (tramp-smb-send-command | 231 (copy-directory dirname tmpdir keep-date parents) |
| 232 v (format "cd \"%s\"" | 232 (copy-directory tmpdir newname keep-date parents)) |
| 233 (tramp-smb-get-localname localname t))) | 233 (delete-directory tmpdir 'recursive)))) |
| 234 (tramp-smb-send-command | 234 ((or t1 t2) |
| 235 v (format "lcd \"%s\"" (if t1 newname dirname))) | 235 ;; We can copy recursively. |
| 236 (if t1 | 236 (let ((prompt (tramp-smb-send-command v "prompt")) |
| 237 (tramp-smb-send-command v "mget *") | 237 (recurse (tramp-smb-send-command v "recurse"))) |
| 238 (tramp-smb-send-command v "mput *"))) | 238 (unless (file-directory-p newname) |
| 239 ;; Error. | 239 (make-directory newname parents)) |
| 240 (with-current-buffer (tramp-get-connection-buffer v) | 240 (unwind-protect |
| 241 (goto-char (point-min)) | 241 (unless |
| 242 (search-forward-regexp tramp-smb-errors nil t) | 242 (and |
| 243 (tramp-error | 243 prompt recurse |
| 244 v 'file-error | 244 (tramp-smb-send-command |
| 245 "%s `%s'" (match-string 0) (if t1 dirname newname)))) | 245 v (format "cd \"%s\"" |
| 246 ;; Always go home. | 246 (tramp-smb-get-localname localname t))) |
| 247 (tramp-smb-send-command v (format "cd \\")) | 247 (tramp-smb-send-command |
| 248 ;; Toggle prompt and recurse OFF. | 248 v (format "lcd \"%s\"" (if t1 newname dirname))) |
| 249 (if prompt (tramp-smb-send-command v "prompt")) | 249 (if t1 |
| 250 (if recurse (tramp-smb-send-command v "recurse")))) | 250 (tramp-smb-send-command v "mget *") |
| 251 | 251 (tramp-smb-send-command v "mput *"))) |
| 252 ;; Error. | |
| 253 (with-current-buffer (tramp-get-connection-buffer v) | |
| 254 (goto-char (point-min)) | |
| 255 (search-forward-regexp tramp-smb-errors nil t) | |
| 256 (tramp-error | |
| 257 v 'file-error | |
| 258 "%s `%s'" (match-string 0) (if t1 dirname newname)))) | |
| 259 ;; Always go home. | |
| 260 (tramp-smb-send-command v (format "cd \\")) | |
| 261 ;; Toggle prompt and recurse OFF. | |
| 262 (if prompt (tramp-smb-send-command v "prompt")) | |
| 263 (if recurse (tramp-smb-send-command v "recurse"))))) | |
| 264 (t | |
| 252 ;; We must do it file-wise. | 265 ;; We must do it file-wise. |
| 253 (tramp-run-real-handler | 266 (tramp-run-real-handler |
| 254 'copy-directory (list dirname newname keep-date parents)))))) | 267 'copy-directory (list dirname newname keep-date parents))))))) |
| 255 | 268 |
| 256 (defun tramp-smb-handle-copy-file | 269 (defun tramp-smb-handle-copy-file |
| 257 (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid) | 270 (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid) |
| 258 "Like `copy-file' for Tramp files. | 271 "Like `copy-file' for Tramp files. |
| 259 KEEP-DATE is not handled in case NEWNAME resides on an SMB server. | 272 KEEP-DATE is not handled in case NEWNAME resides on an SMB server. |
| 398 ;; If NAME is not a Tramp file, run the real handler. | 411 ;; If NAME is not a Tramp file, run the real handler. |
| 399 (if (not (tramp-tramp-file-p name)) | 412 (if (not (tramp-tramp-file-p name)) |
| 400 (tramp-run-real-handler 'expand-file-name (list name nil)) | 413 (tramp-run-real-handler 'expand-file-name (list name nil)) |
| 401 ;; Dissect NAME. | 414 ;; Dissect NAME. |
| 402 (with-parsed-tramp-file-name name nil | 415 (with-parsed-tramp-file-name name nil |
| 416 ;; Tilde expansion if necessary. We use the user name as share, | |
| 417 ;; which is offen the case in domains. | |
| 418 (when (string-match "\\`/?~\\([^/]*\\)" localname) | |
| 419 (setq localname | |
| 420 (replace-match | |
| 421 (if (zerop (length (match-string 1 localname))) | |
| 422 (tramp-file-name-real-user v) | |
| 423 (match-string 1 localname)) | |
| 424 nil nil localname))) | |
| 425 ;; Make the file name absolute. | |
| 403 (unless (tramp-run-real-handler 'file-name-absolute-p (list localname)) | 426 (unless (tramp-run-real-handler 'file-name-absolute-p (list localname)) |
| 404 (setq localname (concat "/" localname))) | 427 (setq localname (concat "/" localname))) |
| 405 ;; Tilde expansion if necessary. We use the user name as share, | |
| 406 ;; which is offen the case in work groups. | |
| 407 (when (string-match "\\`~[^/]*" localname) | |
| 408 (setq localname | |
| 409 (replace-match | |
| 410 (if (zerop (length (match-string 0 localname))) | |
| 411 (tramp-file-name-real-user v) | |
| 412 (match-string 0 localname)) | |
| 413 nil nil localname))) | |
| 414 ;; No tilde characters in file name, do normal | 428 ;; No tilde characters in file name, do normal |
| 415 ;; `expand-file-name' (this does "/./" and "/../"). | 429 ;; `expand-file-name' (this does "/./" and "/../"). |
| 416 (tramp-make-tramp-file-name | 430 (tramp-make-tramp-file-name |
| 417 method user host | 431 method user host |
| 418 (tramp-run-real-handler 'expand-file-name (list localname)))))) | 432 (tramp-run-real-handler 'expand-file-name (list localname)))))) |
| 998 (smbclient-version | 1012 (smbclient-version |
| 999 (shell-command-to-string (concat tramp-smb-program " -V")))) | 1013 (shell-command-to-string (concat tramp-smb-program " -V")))) |
| 1000 (unless (string-equal | 1014 (unless (string-equal |
| 1001 smbclient-version | 1015 smbclient-version |
| 1002 (tramp-get-connection-property vec "smbclient-version" "")) | 1016 (tramp-get-connection-property vec "smbclient-version" "")) |
| 1003 (tramp-flush-directory-property vec "") | 1017 (when (tramp-get-connection-property vec "smbclient-version" nil) |
| 1004 (tramp-flush-connection-property vec) | 1018 (tramp-flush-directory-property vec "") |
| 1019 (tramp-flush-connection-property vec) | |
| 1020 ); (setq buf (tramp-get-buffer vec))) | |
| 1005 (tramp-set-connection-property | 1021 (tramp-set-connection-property |
| 1006 vec "smbclient-version" smbclient-version) | 1022 vec "smbclient-version" smbclient-version)))) |
| 1007 (setq buf (tramp-get-buffer vec))))) | |
| 1008 | 1023 |
| 1009 ;; If too much time has passed since last command was sent, look | 1024 ;; If too much time has passed since last command was sent, look |
| 1010 ;; whether there has been an error message; maybe due to | 1025 ;; whether there has been an error message; maybe due to |
| 1011 ;; connection timeout. | 1026 ;; connection timeout. |
| 1012 (with-current-buffer buf | 1027 (with-current-buffer buf |
| 1087 (with-current-buffer (tramp-get-connection-buffer vec) | 1102 (with-current-buffer (tramp-get-connection-buffer vec) |
| 1088 (goto-char (point-min)) | 1103 (goto-char (point-min)) |
| 1089 (search-forward-regexp | 1104 (search-forward-regexp |
| 1090 "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]" nil t) | 1105 "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]" nil t) |
| 1091 (let ((smbserver-version (match-string 0))) | 1106 (let ((smbserver-version (match-string 0))) |
| 1092 (when (not (string-equal | 1107 (unless (string-equal |
| 1093 smbserver-version | 1108 smbserver-version |
| 1094 (tramp-get-connection-property | 1109 (tramp-get-connection-property |
| 1095 vec "smbserver-version" ""))) | 1110 vec "smbserver-version" "")) |
| 1096 (tramp-flush-directory-property vec "") | 1111 (when (tramp-get-connection-property |
| 1097 (tramp-flush-connection-property vec) | 1112 vec "smbserver-version" nil) |
| 1113 (tramp-flush-directory-property vec "") | |
| 1114 (tramp-flush-connection-property vec)) | |
| 1098 (tramp-set-connection-property | 1115 (tramp-set-connection-property |
| 1099 vec "smbserver-version" smbserver-version)))) | 1116 vec "smbserver-version" smbserver-version)))) |
| 1100 | 1117 |
| 1101 ;; Set chunksize. Otherwise, `tramp-send-string' might | 1118 ;; Set chunksize. Otherwise, `tramp-send-string' might |
| 1102 ;; try it itself. | 1119 ;; try it itself. |