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. |