Mercurial > emacs

comparison lisp/net/tramp-smb.el @ 105616:13878abadf01

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
* net/tramp-smb.el (tramp-smb-errors): Add error messages. (tramp-smb-get-share, tramp-smb-get-localname): Use only VEC as parameter. (tramp-smb-handle-add-name-to-file) (tramp-smb-handle-copy-directory, tramp-smb-handle-copy-file) (tramp-smb-handle-delete-directory, tramp-smb-handle-delete-file) (tramp-smb-handle-file-attributes) (tramp-smb-do-file-attributes-with-stat) (tramp-smb-handle-file-local-copy) (tramp-smb-handle-insert-directory) (tramp-smb-handle-make-directory) (tramp-smb-handle-make-directory-internal) (tramp-smb-handle-make-symbolic-link) (tramp-smb-handle-rename-file, tramp-smb-handle-set-file-modes) (tramp-smb-handle-write-region, tramp-smb-get-file-entries) (tramp-smb-maybe-open-connection): Apply the changed parameters. (tramp-smb-read-file-entry): Read Disk names in compressed format. Handle long file names. (tramp-smb-get-cifs-capabilities): Check, whether the connection process is running. (tramp-smb-maybe-open-connection): Trace "smbclient -V" command. Read share names with "-g" option.
author Michael Albinus <michael.albinus@gmx.de>
date Thu, 15 Oct 2009 13:17:07 +0000
parents be1e297cc4d5
children 75fb0870b7e0
comparison
equal deleted inserted replaced
105615:33df72cf19f1 105616:13878abadf01
74 "Call timed out: server did not respond" 74 "Call timed out: server did not respond"
75 "\\S-+: command not found" 75 "\\S-+: command not found"
76 "Server doesn't support UNIX CIFS calls" 76 "Server doesn't support UNIX CIFS calls"
77 ;; Samba. 77 ;; Samba.
78 "ERRDOS" 78 "ERRDOS"
79 "ERRHRD"
79 "ERRSRV" 80 "ERRSRV"
80 "ERRbadfile" 81 "ERRbadfile"
81 "ERRbadpw" 82 "ERRbadpw"
82 "ERRfilexists" 83 "ERRfilexists"
83 "ERRnoaccess" 84 "ERRnoaccess"
239 "add-name-to-file: file %s already exists" newname)) 240 "add-name-to-file: file %s already exists" newname))
240 ;; We must also flush the cache of the directory, because 241 ;; We must also flush the cache of the directory, because
241 ;; `file-attributes' reads the values from there. 242 ;; `file-attributes' reads the values from there.
242 (tramp-flush-file-property v2 (file-name-directory v2-localname)) 243 (tramp-flush-file-property v2 (file-name-directory v2-localname))
243 (tramp-flush-file-property v2 v2-localname) 244 (tramp-flush-file-property v2 v2-localname)
244 (let ((cifs (tramp-smb-get-cifs-capabilities v1))) 245 (unless
245 (unless 246 (tramp-smb-send-command
246 (tramp-smb-send-command 247 v1
247 v1 248 (format
248 (format 249 "%s \"%s\" \"%s\""
249 "%s \"%s\" \"%s\"" 250 (if (tramp-smb-get-cifs-capabilities v1) "link" "hardlink")
250 (if cifs "link" "hardlink") 251 (tramp-smb-get-localname v1)
251 (tramp-smb-get-localname v1-localname (not cifs)) 252 (tramp-smb-get-localname v2)))
252 (tramp-smb-get-localname v2-localname (not cifs)))) 253 (tramp-error
253 (tramp-error 254 v2 'file-error
254 v2 'file-error 255 "error with add-name-to-file, see buffer `%s' for details"
255 "error with add-name-to-file, see buffer `%s' for details" 256 (buffer-name))))))
256 (buffer-name)))))))
257 257
258 (defun tramp-smb-handle-copy-directory 258 (defun tramp-smb-handle-copy-directory
259 (dirname newname &optional keep-date parents) 259 (dirname newname &optional keep-date parents)
260 "Like `copy-directory' for Tramp files." 260 "Like `copy-directory' for Tramp files. KEEP-DATE is not handled."
261 (setq dirname (expand-file-name dirname) 261 (setq dirname (expand-file-name dirname)
262 newname (expand-file-name newname)) 262 newname (expand-file-name newname))
263 (let ((t1 (tramp-tramp-file-p dirname)) 263 (let ((t1 (tramp-tramp-file-p dirname))
264 (t2 (tramp-tramp-file-p newname))) 264 (t2 (tramp-tramp-file-p newname)))
265 (with-parsed-tramp-file-name (if t1 dirname newname) nil 265 (with-parsed-tramp-file-name (if t1 dirname newname) nil
266 (cond 266 (cond
267 ;; We must use a local temporary directory.
267 ((and t1 t2) 268 ((and t1 t2)
268 ;; We must copy, using a local temporary directory.
269 (let ((tmpdir 269 (let ((tmpdir
270 (make-temp-name 270 (make-temp-name
271 (expand-file-name 271 (expand-file-name
272 tramp-temp-name-prefix 272 tramp-temp-name-prefix
273 (tramp-compat-temporary-file-directory))))) 273 (tramp-compat-temporary-file-directory)))))
274 (unwind-protect 274 (unwind-protect
275 (progn 275 (progn
276 (copy-directory dirname tmpdir keep-date parents) 276 (copy-directory dirname tmpdir keep-date parents)
277 (copy-directory tmpdir newname keep-date parents)) 277 (copy-directory tmpdir newname keep-date parents))
278 (delete-directory tmpdir 'recursive)))) 278 (delete-directory tmpdir 'recursive))))
279
280 ;; We can copy recursively.
279 ((or t1 t2) 281 ((or t1 t2)
280 ;; We can copy recursively.
281 (let ((prompt (tramp-smb-send-command v "prompt")) 282 (let ((prompt (tramp-smb-send-command v "prompt"))
282 (recurse (tramp-smb-send-command v "recurse")) 283 (recurse (tramp-smb-send-command v "recurse")))
283 (cifs (tramp-smb-get-cifs-capabilities v)))
284 (unless (file-directory-p newname) 284 (unless (file-directory-p newname)
285 (make-directory newname parents)) 285 (make-directory newname parents))
286 (unwind-protect 286 (unwind-protect
287 (unless 287 (unless
288 (and 288 (and
289 prompt recurse 289 prompt recurse
290 (tramp-smb-send-command 290 (tramp-smb-send-command
291 v (format 291 v (format "cd \"%s\"" (tramp-smb-get-localname v)))
292 "cd \"%s\""
293 (tramp-smb-get-localname localname (not cifs))))
294 (tramp-smb-send-command 292 (tramp-smb-send-command
295 v (format "lcd \"%s\"" (if t1 newname dirname))) 293 v (format "lcd \"%s\"" (if t1 newname dirname)))
296 (if t1 294 (if t1
297 (tramp-smb-send-command v "mget *") 295 (tramp-smb-send-command v "mget *")
298 (tramp-smb-send-command v "mput *"))) 296 (tramp-smb-send-command v "mput *")))
302 (search-forward-regexp tramp-smb-errors nil t) 300 (search-forward-regexp tramp-smb-errors nil t)
303 (tramp-error 301 (tramp-error
304 v 'file-error 302 v 'file-error
305 "%s `%s'" (match-string 0) (if t1 dirname newname)))) 303 "%s `%s'" (match-string 0) (if t1 dirname newname))))
306 ;; Go home. 304 ;; Go home.
307 (tramp-smb-send-command v (format "cd %s" (if cifs "/" "\\"))) 305 (tramp-smb-send-command
306 v (format
307 "cd %s" (if (tramp-smb-get-cifs-capabilities v) "/" "\\")))
308 ;; Toggle prompt and recurse OFF. 308 ;; Toggle prompt and recurse OFF.
309 (if prompt (tramp-smb-send-command v "prompt")) 309 (if prompt (tramp-smb-send-command v "prompt"))
310 (if recurse (tramp-smb-send-command v "recurse"))))) 310 (if recurse (tramp-smb-send-command v "recurse")))))
311
312 ;; We must do it file-wise.
311 (t 313 (t
312 ;; We must do it file-wise.
313 (tramp-run-real-handler 314 (tramp-run-real-handler
314 'copy-directory (list dirname newname keep-date parents))))))) 315 'copy-directory (list dirname newname keep-date parents)))))))
315 316
316 (defun tramp-smb-handle-copy-file 317 (defun tramp-smb-handle-copy-file
317 (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid) 318 (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
343 344
344 ;; We must also flush the cache of the directory, because 345 ;; We must also flush the cache of the directory, because
345 ;; `file-attributes' reads the values from there. 346 ;; `file-attributes' reads the values from there.
346 (tramp-flush-file-property v (file-name-directory localname)) 347 (tramp-flush-file-property v (file-name-directory localname))
347 (tramp-flush-file-property v localname) 348 (tramp-flush-file-property v localname)
348 (let ((share (tramp-smb-get-share localname)) 349 (unless (tramp-smb-get-share v)
349 (file (tramp-smb-get-localname 350 (tramp-error
350 localname (not (tramp-smb-get-cifs-capabilities v))))) 351 v 'file-error "Target `%s' must contain a share name" newname))
351 (unless share 352 (tramp-message v 0 "Copying file %s to file %s..." filename newname)
352 (tramp-error 353 (if (tramp-smb-send-command
353 v 'file-error "Target `%s' must contain a share name" newname)) 354 v (format "put \"%s\" \"%s\""
354 (tramp-message v 0 "Copying file %s to file %s..." filename newname) 355 filename (tramp-smb-get-localname v)))
355 (if (tramp-smb-send-command 356 (tramp-message
356 v (format "put %s \"%s\"" filename file)) 357 v 0 "Copying file %s to file %s...done" filename newname)
357 (tramp-message 358 (tramp-error v 'file-error "Cannot copy `%s'" filename)))))
358 v 0 "Copying file %s to file %s...done" filename newname)
359 (tramp-error v 'file-error "Cannot copy `%s'" filename))))))
360 359
361 ;; KEEP-DATE handling. 360 ;; KEEP-DATE handling.
362 (when keep-date (set-file-times newname (nth 5 (file-attributes filename))))) 361 (when keep-date (set-file-times newname (nth 5 (file-attributes filename)))))
363 362
364 (defun tramp-smb-handle-delete-directory (directory &optional recursive) 363 (defun tramp-smb-handle-delete-directory (directory &optional recursive)
372 (delete-directory file recursive) 371 (delete-directory file recursive)
373 (delete-file file))) 372 (delete-file file)))
374 ;; We do not want to delete "." and "..". 373 ;; We do not want to delete "." and "..".
375 (directory-files 374 (directory-files
376 directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) 375 directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
376
377 (with-parsed-tramp-file-name directory nil 377 (with-parsed-tramp-file-name directory nil
378 ;; We must also flush the cache of the directory, because 378 ;; We must also flush the cache of the directory, because
379 ;; `file-attributes' reads the values from there. 379 ;; `file-attributes' reads the values from there.
380 (tramp-flush-file-property v (file-name-directory localname)) 380 (tramp-flush-file-property v (file-name-directory localname))
381 (tramp-flush-directory-property v localname) 381 (tramp-flush-directory-property v localname)
382 (let ((cifs (tramp-smb-get-cifs-capabilities v))) 382 (unless (tramp-smb-send-command
383 (unless (tramp-smb-send-command 383 v (format
384 v (format 384 "%s \"%s\""
385 "%s \"%s\"" 385 (if (tramp-smb-get-cifs-capabilities v) "posix_rmdir" "rmdir")
386 (if cifs "posix_rmdir" "rmdir") 386 (tramp-smb-get-localname v)))
387 (tramp-smb-get-localname localname (not cifs)))) 387 ;; Error.
388 ;; Error. 388 (with-current-buffer (tramp-get-connection-buffer v)
389 (with-current-buffer (tramp-get-connection-buffer v) 389 (goto-char (point-min))
390 (goto-char (point-min)) 390 (search-forward-regexp tramp-smb-errors nil t)
391 (search-forward-regexp tramp-smb-errors nil t) 391 (tramp-error
392 (tramp-error 392 v 'file-error "%s `%s'" (match-string 0) directory))))))
393 v 'file-error "%s `%s'" (match-string 0) directory)))))))
394 393
395 (defun tramp-smb-handle-delete-file (filename) 394 (defun tramp-smb-handle-delete-file (filename)
396 "Like `delete-file' for Tramp files." 395 "Like `delete-file' for Tramp files."
397 (setq filename (expand-file-name filename)) 396 (setq filename (expand-file-name filename))
398 (when (file-exists-p filename) 397 (when (file-exists-p filename)
399 (with-parsed-tramp-file-name filename nil 398 (with-parsed-tramp-file-name filename nil
400 ;; We must also flush the cache of the directory, because 399 ;; We must also flush the cache of the directory, because
401 ;; `file-attributes' reads the values from there. 400 ;; `file-attributes' reads the values from there.
402 (tramp-flush-file-property v (file-name-directory localname)) 401 (tramp-flush-file-property v (file-name-directory localname))
403 (tramp-flush-file-property v localname) 402 (tramp-flush-file-property v localname)
404 (let ((cifs (tramp-smb-get-cifs-capabilities v))) 403 (unless (tramp-smb-send-command
405 (unless (tramp-smb-send-command 404 v (format
406 v (format 405 "%s \"%s\""
407 "%s \"%s\"" 406 (if (tramp-smb-get-cifs-capabilities v) "posix_unlink" "rm")
408 (if cifs "posix_unlink" "rm") 407 (tramp-smb-get-localname v)))
409 (tramp-smb-get-localname localname (not cifs)))) 408 ;; Error.
410 ;; Error. 409 (with-current-buffer (tramp-get-connection-buffer v)
411 (with-current-buffer (tramp-get-connection-buffer v) 410 (goto-char (point-min))
412 (goto-char (point-min)) 411 (search-forward-regexp tramp-smb-errors nil t)
413 (search-forward-regexp tramp-smb-errors nil t) 412 (tramp-error
414 (tramp-error 413 v 'file-error "%s `%s'" (match-string 0) filename))))))
415 v 'file-error "%s `%s'" (match-string 0) filename)))))))
416 414
417 (defun tramp-smb-handle-directory-files 415 (defun tramp-smb-handle-directory-files
418 (directory &optional full match nosort) 416 (directory &optional full match nosort)
419 "Like `directory-files' for Tramp files." 417 "Like `directory-files' for Tramp files."
420 (let ((result (mapcar 'directory-file-name 418 (let ((result (mapcar 'directory-file-name
478 (defun tramp-smb-handle-file-attributes (filename &optional id-format) 476 (defun tramp-smb-handle-file-attributes (filename &optional id-format)
479 "Like `file-attributes' for Tramp files." 477 "Like `file-attributes' for Tramp files."
480 (unless id-format (setq id-format 'integer)) 478 (unless id-format (setq id-format 'integer))
481 (with-parsed-tramp-file-name filename nil 479 (with-parsed-tramp-file-name filename nil
482 (with-file-property v localname (format "file-attributes-%s" id-format) 480 (with-file-property v localname (format "file-attributes-%s" id-format)
483 (if (and (tramp-smb-get-share localname) 481 (if (and (tramp-smb-get-share v) (tramp-smb-get-cifs-capabilities v))
484 (tramp-smb-get-cifs-capabilities v)) 482 (tramp-smb-do-file-attributes-with-stat v id-format)
485 (tramp-smb-do-file-attributes-with-stat v localname id-format)
486 ;; Reading just the filename entry via "dir localname" is not 483 ;; Reading just the filename entry via "dir localname" is not
487 ;; possible, because when filename is a directory, some 484 ;; possible, because when filename is a directory, some
488 ;; smbclient versions return the content of the directory, and 485 ;; smbclient versions return the content of the directory, and
489 ;; other versions don't. Therefore, the whole content of the 486 ;; other versions don't. Therefore, the whole content of the
490 ;; upper directory is retrieved, and the entry of the filename 487 ;; upper directory is retrieved, and the entry of the filename
511 (nth 1 entry) ;8 mode 508 (nth 1 entry) ;8 mode
512 nil ;9 gid weird 509 nil ;9 gid weird
513 inode ;10 inode number 510 inode ;10 inode number
514 device))))))) ;11 file system number 511 device))))))) ;11 file system number
515 512
516 (defun tramp-smb-do-file-attributes-with-stat 513 (defun tramp-smb-do-file-attributes-with-stat (vec &optional id-format)
517 (vec localname &optional id-format)
518 "Implement `file-attributes' for Tramp files using stat command." 514 "Implement `file-attributes' for Tramp files using stat command."
519 (tramp-message vec 5 "file attributes with stat: %s" localname) 515 (tramp-message
516 vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec))
520 (with-current-buffer (tramp-get-buffer vec) 517 (with-current-buffer (tramp-get-buffer vec)
521 (let* ((file (tramp-smb-get-localname localname nil)) 518 (let* (size id link uid gid atime mtime ctime mode inode)
522 size id link uid gid atime mtime ctime mode inode) 519 (unless
523 (tramp-smb-send-command vec (format "stat \"%s\"" file)) 520 (tramp-smb-send-command
521 vec (format "stat \"%s\"" (tramp-smb-get-localname vec)))
522 ;; Error.
523 (with-current-buffer (tramp-get-connection-buffer vec)
524 (goto-char (point-min))
525 (search-forward-regexp tramp-smb-errors nil t)
526 (tramp-error
527 vec 'file-error "%s" (match-string 0))))
524 528
525 ;; Loop the listing. 529 ;; Loop the listing.
526 (goto-char (point-min)) 530 (goto-char (point-min))
527 (unless (re-search-forward tramp-smb-errors nil t) 531 (unless (re-search-forward tramp-smb-errors nil t)
528 (while (not (eobp)) 532 (while (not (eobp))
529 (cond 533 (cond
530 ;;File: /dbus
531 ((looking-at 534 ((looking-at
532 "Size:\\s-+\\([0-9]+\\)\\s-+Blocks:\\s-+[0-9]+\\s-+\\(\\w+\\)") 535 "Size:\\s-+\\([0-9]+\\)\\s-+Blocks:\\s-+[0-9]+\\s-+\\(\\w+\\)")
533 (setq size (string-to-number (match-string 1)) 536 (setq size (string-to-number (match-string 1))
534 id (if (string-equal "directory" (match-string 2)) t 537 id (if (string-equal "directory" (match-string 2)) t
535 (if (string-equal "symbolic" (match-string 2)) "")))) 538 (if (string-equal "symbolic" (match-string 2)) ""))))
593 (with-parsed-tramp-file-name filename nil 596 (with-parsed-tramp-file-name filename nil
594 (unless (file-exists-p filename) 597 (unless (file-exists-p filename)
595 (tramp-error 598 (tramp-error
596 v 'file-error 599 v 'file-error
597 "Cannot make local copy of non-existing file `%s'" filename)) 600 "Cannot make local copy of non-existing file `%s'" filename))
598 (let ((file (tramp-smb-get-localname 601 (let ((tmpfile (tramp-compat-make-temp-file filename)))
599 localname (not (tramp-smb-get-cifs-capabilities v))))
600 (tmpfile (tramp-compat-make-temp-file filename)))
601 (tramp-message v 4 "Fetching %s to tmp file %s..." filename tmpfile) 602 (tramp-message v 4 "Fetching %s to tmp file %s..." filename tmpfile)
602 (if (tramp-smb-send-command v (format "get \"%s\" %s" file tmpfile)) 603 (if (tramp-smb-send-command
604 v (format "get \"%s\" \"%s\"" (tramp-smb-get-localname v) tmpfile))
603 (tramp-message 605 (tramp-message
604 v 4 "Fetching %s to tmp file %s...done" filename tmpfile) 606 v 4 "Fetching %s to tmp file %s...done" filename tmpfile)
605 ;; Oops, an error. We shall cleanup. 607 ;; Oops, an error. We shall cleanup.
606 (delete-file tmpfile) 608 (delete-file tmpfile)
607 (tramp-error 609 (tramp-error
608 v 'file-error 610 v 'file-error "Cannot make local copy of file `%s'" filename))
609 "Cannot make local copy of file `%s'" filename))
610 tmpfile))) 611 tmpfile)))
611 612
612 ;; This function should return "foo/" for directories and "bar" for 613 ;; This function should return "foo/" for directories and "bar" for
613 ;; files. 614 ;; files.
614 (defun tramp-smb-handle-file-name-all-completions (filename directory) 615 (defun tramp-smb-handle-file-name-all-completions (filename directory)
650 (when full-directory-p 651 (when full-directory-p
651 ;; Called from `dired-add-entry'. 652 ;; Called from `dired-add-entry'.
652 (setq filename (file-name-as-directory filename))) 653 (setq filename (file-name-as-directory filename)))
653 (with-parsed-tramp-file-name filename nil 654 (with-parsed-tramp-file-name filename nil
654 (save-match-data 655 (save-match-data
655 (let ((cifs (tramp-smb-get-cifs-capabilities v)) 656 (let ((base (file-name-nondirectory filename))
656 (base (file-name-nondirectory filename))
657 ;; We should not destroy the cache entry. 657 ;; We should not destroy the cache entry.
658 (entries (copy-sequence 658 (entries (copy-sequence
659 (tramp-smb-get-file-entries 659 (tramp-smb-get-file-entries
660 (file-name-directory filename))))) 660 (file-name-directory filename)))))
661 661
708 ;; Print entries. 708 ;; Print entries.
709 (mapcar 709 (mapcar
710 (lambda (x) 710 (lambda (x)
711 (when (not (zerop (length (nth 0 x)))) 711 (when (not (zerop (length (nth 0 x))))
712 (let ((attr 712 (let ((attr
713 (when cifs 713 (when (tramp-smb-get-cifs-capabilities v)
714 (file-attributes (expand-file-name (nth 0 x)) 'string)))) 714 (ignore-errors
715 (file-attributes
716 (expand-file-name (nth 0 x)) 'string)))))
715 (insert 717 (insert
716 (format 718 (format
717 "%10s %3d %-8s %-8s %8s %s %s\n" 719 "%10s %3d %-8s %-8s %8s %s %s\n"
718 (or (nth 8 attr) (nth 1 x)) ; mode 720 (or (nth 8 attr) (nth 1 x)) ; mode
719 (or (nth 1 attr) 1) ; link 721 (or (nth 1 attr) 1) ; link
737 (setq dir (directory-file-name (expand-file-name dir))) 739 (setq dir (directory-file-name (expand-file-name dir)))
738 (unless (file-name-absolute-p dir) 740 (unless (file-name-absolute-p dir)
739 (setq dir (expand-file-name dir default-directory))) 741 (setq dir (expand-file-name dir default-directory)))
740 (with-parsed-tramp-file-name dir nil 742 (with-parsed-tramp-file-name dir nil
741 (save-match-data 743 (save-match-data
742 (let* ((share (tramp-smb-get-share localname)) 744 (let* ((ldir (file-name-directory dir)))
743 (ldir (file-name-directory dir)))
744 ;; Make missing directory parts. 745 ;; Make missing directory parts.
745 (when (and parents share (not (file-directory-p ldir))) 746 (when (and parents
747 (tramp-smb-get-share v)
748 (not (file-directory-p ldir)))
746 (make-directory ldir parents)) 749 (make-directory ldir parents))
747 ;; Just do it. 750 ;; Just do it.
748 (when (file-directory-p ldir) 751 (when (file-directory-p ldir)
749 (make-directory-internal dir)) 752 (make-directory-internal dir))
750 (unless (file-directory-p dir) 753 (unless (file-directory-p dir)
755 (setq directory (directory-file-name (expand-file-name directory))) 758 (setq directory (directory-file-name (expand-file-name directory)))
756 (unless (file-name-absolute-p directory) 759 (unless (file-name-absolute-p directory)
757 (setq directory (expand-file-name directory default-directory))) 760 (setq directory (expand-file-name directory default-directory)))
758 (with-parsed-tramp-file-name directory nil 761 (with-parsed-tramp-file-name directory nil
759 (save-match-data 762 (save-match-data
760 (let* ((cifs (tramp-smb-get-cifs-capabilities v)) 763 (let* ((file (tramp-smb-get-localname v)))
761 (file (tramp-smb-get-localname localname (not cifs))))
762 (when (file-directory-p (file-name-directory directory)) 764 (when (file-directory-p (file-name-directory directory))
763 (tramp-smb-send-command 765 (tramp-smb-send-command
764 v 766 v
765 (if cifs 767 (if (tramp-smb-get-cifs-capabilities v)
766 (format 768 (format
767 "posix_mkdir \"%s\" %s" 769 "posix_mkdir \"%s\" %s"
768 file (tramp-decimal-to-octal (default-file-modes))) 770 file (tramp-decimal-to-octal (default-file-modes)))
769 (format "mkdir \"%s\"" file))) 771 (format "mkdir \"%s\"" file)))
770 ;; We must also flush the cache of the directory, because 772 ;; We must also flush the cache of the directory, because
818 (unless 820 (unless
819 (tramp-smb-send-command 821 (tramp-smb-send-command
820 v1 822 v1
821 (format 823 (format
822 "symlink \"%s\" \"%s\"" 824 "symlink \"%s\" \"%s\""
823 (tramp-smb-get-localname v1-localname nil) 825 (tramp-smb-get-localname v1)
824 (tramp-smb-get-localname v2-localname nil))) 826 (tramp-smb-get-localname v2)))
825 (tramp-error 827 (tramp-error
826 v2 'file-error 828 v2 'file-error
827 "error with make-symbolic-link, see buffer `%s' for details" 829 "error with make-symbolic-link, see buffer `%s' for details"
828 (buffer-name)))))) 830 (buffer-name))))))
829 831
854 (tramp-error v 'file-already-exists newname)) 856 (tramp-error v 'file-already-exists newname))
855 ;; We must also flush the cache of the directory, because 857 ;; We must also flush the cache of the directory, because
856 ;; `file-attributes' reads the values from there. 858 ;; `file-attributes' reads the values from there.
857 (tramp-flush-file-property v (file-name-directory localname)) 859 (tramp-flush-file-property v (file-name-directory localname))
858 (tramp-flush-file-property v localname) 860 (tramp-flush-file-property v localname)
859 (let ((file (tramp-smb-get-localname 861 (tramp-message v 0 "Copying file %s to file %s..." filename newname)
860 localname (not (tramp-smb-get-cifs-capabilities v))))) 862 (if (tramp-smb-send-command
861 (tramp-message v 0 "Copying file %s to file %s..." filename newname) 863 v (format "put %s \"%s\"" filename (tramp-smb-get-localname v)))
862 (if (tramp-smb-send-command v (format "put %s \"%s\"" filename file)) 864 (tramp-message
863 (tramp-message 865 v 0 "Copying file %s to file %s...done" filename newname)
864 v 0 "Copying file %s to file %s...done" filename newname) 866 (tramp-error v 'file-error "Cannot rename `%s'" filename)))))
865 (tramp-error v 'file-error "Cannot rename `%s'" filename))))))
866 867
867 (delete-file filename)) 868 (delete-file filename))
868 869
869 (defun tramp-smb-handle-set-file-modes (filename mode) 870 (defun tramp-smb-handle-set-file-modes (filename mode)
870 "Like `set-file-modes' for Tramp files." 871 "Like `set-file-modes' for Tramp files."
871 (with-parsed-tramp-file-name filename nil 872 (with-parsed-tramp-file-name filename nil
872 (when (tramp-smb-get-cifs-capabilities v) 873 (when (tramp-smb-get-cifs-capabilities v)
873 (tramp-flush-file-property v localname) 874 (tramp-flush-file-property v localname)
874 (unless (tramp-smb-send-command 875 (unless (tramp-smb-send-command
875 v (format "chmod \"%s\" %s" 876 v (format "chmod \"%s\" %s"
876 (tramp-smb-get-localname localname nil) 877 (tramp-smb-get-localname v)
877 (tramp-decimal-to-octal mode))) 878 (tramp-decimal-to-octal mode)))
878 (tramp-error 879 (tramp-error
879 v 'file-error "Error while changing file's mode %s" filename))))) 880 v 'file-error "Error while changing file's mode %s" filename)))))
880 881
881 (defun tramp-smb-handle-substitute-in-file-name (filename) 882 (defun tramp-smb-handle-substitute-in-file-name (filename)
908 (tramp-error v 'file-error "File not overwritten"))) 909 (tramp-error v 'file-error "File not overwritten")))
909 ;; We must also flush the cache of the directory, because 910 ;; We must also flush the cache of the directory, because
910 ;; `file-attributes' reads the values from there. 911 ;; `file-attributes' reads the values from there.
911 (tramp-flush-file-property v (file-name-directory localname)) 912 (tramp-flush-file-property v (file-name-directory localname))
912 (tramp-flush-file-property v localname) 913 (tramp-flush-file-property v localname)
913 (let ((file (tramp-smb-get-localname 914 (let ((curbuf (current-buffer))
914 localname (not (tramp-smb-get-cifs-capabilities v))))
915 (curbuf (current-buffer))
916 (tmpfile (tramp-compat-make-temp-file filename))) 915 (tmpfile (tramp-compat-make-temp-file filename)))
917 ;; We say `no-message' here because we don't want the visited file 916 ;; We say `no-message' here because we don't want the visited file
918 ;; modtime data to be clobbered from the temp file. We call 917 ;; modtime data to be clobbered from the temp file. We call
919 ;; `set-visited-file-modtime' ourselves later on. 918 ;; `set-visited-file-modtime' ourselves later on.
920 (tramp-run-real-handler 919 (tramp-run-real-handler
923 (list start end tmpfile append 'no-message lockname confirm) 922 (list start end tmpfile append 'no-message lockname confirm)
924 (list start end tmpfile append 'no-message lockname))) 923 (list start end tmpfile append 'no-message lockname)))
925 924
926 (tramp-message v 5 "Writing tmp file %s to file %s..." tmpfile filename) 925 (tramp-message v 5 "Writing tmp file %s to file %s..." tmpfile filename)
927 (unwind-protect 926 (unwind-protect
928 (if (tramp-smb-send-command v (format "put %s \"%s\"" tmpfile file)) 927 (if (tramp-smb-send-command
928 v (format "put %s \"%s\"" tmpfile (tramp-smb-get-localname v)))
929 (tramp-message 929 (tramp-message
930 v 5 "Writing tmp file %s to file %s...done" tmpfile filename) 930 v 5 "Writing tmp file %s to file %s...done" tmpfile filename)
931 (tramp-error v 'file-error "Cannot write `%s'" filename)) 931 (tramp-error v 'file-error "Cannot write `%s'" filename))
932 (delete-file tmpfile)) 932 (delete-file tmpfile))
933 933
939 (set-visited-file-modtime))))) 939 (set-visited-file-modtime)))))
940 940
941 941
942 ;; Internal file name functions. 942 ;; Internal file name functions.
943 943
944 (defun tramp-smb-get-share (localname) 944 (defun tramp-smb-get-share (vec)
945 "Returns the share name of LOCALNAME." 945 "Returns the share name of LOCALNAME."
946 (save-match-data 946 (save-match-data
947 (when (string-match "^/?\\([^/]+\\)/" localname) 947 (let ((localname (tramp-file-name-localname vec)))
948 (match-string 1 localname)))) 948 (when (string-match "^/?\\([^/]+\\)/" localname)
949 949 (match-string 1 localname)))))
950 (defun tramp-smb-get-localname (localname convert) 950
951 (defun tramp-smb-get-localname (vec)
951 "Returns the file name of LOCALNAME. 952 "Returns the file name of LOCALNAME.
952 If CONVERT is non-nil exchange \"/\" by \"\\\\\"." 953 If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"."
953 (save-match-data 954 (save-match-data
954 (let ((res localname)) 955 (let ((localname (tramp-file-name-localname vec)))
955
956 (setq 956 (setq
957 res (if (string-match "^/?[^/]+/\\(.*\\)" res) 957 localname
958 (if convert 958 (if (string-match "^/?[^/]+\\(/.*\\)" localname)
959 (mapconcat 959 ;; There is a share, sparated by "/".
960 (lambda (x) (if (equal x ?/) "\\" (char-to-string x))) 960 (if (not (tramp-smb-get-cifs-capabilities vec))
961 (match-string 1 res) "") 961 (mapconcat
962 (match-string 1 res)) 962 (lambda (x) (if (equal x ?/) "\\" (char-to-string x)))
963 (if (string-match "^/?\\([^/]+\\)$" res) 963 (match-string 1 localname) "")
964 (match-string 1 res) 964 (match-string 1 localname))
965 ""))) 965 ;; There is just a share.
966 (if (string-match "^/?\\([^/]+\\)$" localname)
967 (match-string 1 localname)
968 "")))
966 969
967 ;; Sometimes we have discarded `substitute-in-file-name'. 970 ;; Sometimes we have discarded `substitute-in-file-name'.
968 (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" res) 971 (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" localname)
969 (setq res (replace-match "$" nil nil res 1))) 972 (setq localname (replace-match "$" nil nil localname 1)))
970 973
971 res))) 974 localname)))
972 975
973 ;; Share names of a host are cached. It is very unlikely that the 976 ;; Share names of a host are cached. It is very unlikely that the
974 ;; shares do change during connection. 977 ;; shares do change during connection.
975 (defun tramp-smb-get-file-entries (directory) 978 (defun tramp-smb-get-file-entries (directory)
976 "Read entries which match DIRECTORY. 979 "Read entries which match DIRECTORY.
977 Either the shares are listed, or the `dir' command is executed. 980 Either the shares are listed, or the `dir' command is executed.
978 Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)." 981 Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
979 (with-parsed-tramp-file-name directory nil 982 (with-parsed-tramp-file-name (file-name-as-directory directory) nil
980 (setq localname (or localname "/")) 983 (setq localname (or localname "/"))
981 (with-file-property v localname "file-entries" 984 (with-file-property v localname "file-entries"
982 (with-current-buffer (tramp-get-buffer v) 985 (with-current-buffer (tramp-get-buffer v)
983 (let* ((share (tramp-smb-get-share localname)) 986 (let* ((share (tramp-smb-get-share v))
984 (file (tramp-smb-get-localname localname nil))
985 (cache (tramp-get-connection-property v "share-cache" nil)) 987 (cache (tramp-get-connection-property v "share-cache" nil))
986 res entry) 988 res entry)
987 989
988 (if (and (not share) cache) 990 (if (and (not share) cache)
989 ;; Return cached shares. 991 ;; Return cached shares.
990 (setq res cache) 992 (setq res cache)
991 993
992 ;; Read entries. 994 ;; Read entries.
993 (setq file (file-name-as-directory file))
994 (when (string-match "^\\./" file)
995 (setq file (substring file 1)))
996 (if share 995 (if share
997 (tramp-smb-send-command v (format "dir \"%s*\"" file)) 996 (tramp-smb-send-command
997 v (format "dir \"%s*\"" (tramp-smb-get-localname v)))
998 ;; `tramp-smb-maybe-open-connection' lists also the share names. 998 ;; `tramp-smb-maybe-open-connection' lists also the share names.
999 (tramp-smb-maybe-open-connection v)) 999 (tramp-smb-maybe-open-connection v))
1000 1000
1001 ;; Loop the listing. 1001 ;; Loop the listing.
1002 (goto-char (point-min)) 1002 (goto-char (point-min))
1003 (unless (re-search-forward tramp-smb-errors nil t) 1003 (if (re-search-forward tramp-smb-errors nil t)
1004 (tramp-error v 'file-error "%s `%s'" (match-string 0) directory)
1004 (while (not (eobp)) 1005 (while (not (eobp))
1005 (setq entry (tramp-smb-read-file-entry share)) 1006 (setq entry (tramp-smb-read-file-entry share))
1006 (forward-line) 1007 (forward-line)
1007 (when entry (add-to-list 'res entry)))) 1008 (when entry (add-to-list 'res entry))))
1008 1009
1022 1023
1023 ;; Return either a share name (if SHARE is nil), or a file name. 1024 ;; Return either a share name (if SHARE is nil), or a file name.
1024 ;; 1025 ;;
1025 ;; If shares are listed, the following format is expected: 1026 ;; If shares are listed, the following format is expected:
1026 ;; 1027 ;;
1027 ;; \s-\{8,8} - leading spaces 1028 ;; Disk| - leading spaces
1028 ;; \S-\(.*\S-\)\s-* - share name, 14 char 1029 ;; [^|]+| - share name, 14 char
1029 ;; \s- - space delimeter 1030 ;; .* - comment
1030 ;; \S-+\s-* - type, 8 char, "Disk " expected
1031 ;; \(\s-\{2,2\}.*\)? - space delimeter, comment
1032 ;; 1031 ;;
1033 ;; Entries provided by smbclient DIR aren't fully regular. 1032 ;; Entries provided by smbclient DIR aren't fully regular.
1034 ;; They should have the format 1033 ;; They should have the format
1035 ;; 1034 ;;
1036 ;; \s-\{2,2} - leading spaces 1035 ;; \s-\{2,2} - leading spaces
1084 localname mode size month day hour min sec year mtime) 1083 localname mode size month day hour min sec year mtime)
1085 1084
1086 (if (not share) 1085 (if (not share)
1087 1086
1088 ;; Read share entries. 1087 ;; Read share entries.
1089 (when (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-+Disk" line) 1088 (when (string-match "^Disk|\\([^|]+\\)|" line)
1090 (setq localname (match-string 1 line) 1089 (setq localname (match-string 1 line)
1091 mode "dr-xr-xr-x" 1090 mode "dr-xr-xr-x"
1092 size 0)) 1091 size 0))
1093 1092
1094 ;; Real listing. 1093 ;; Real listing.
1142 "%s%s" 1141 "%s%s"
1143 (if (string-match "D" mode) "d" "-") 1142 (if (string-match "D" mode) "d" "-")
1144 (mapconcat 1143 (mapconcat
1145 (lambda (x) "") " " 1144 (lambda (x) "") " "
1146 (concat "r" (if (string-match "R" mode) "-" "w") "x")))) 1145 (concat "r" (if (string-match "R" mode) "-" "w") "x"))))
1147 line (substring line 0 -7)) 1146 line (substring line 0 -6))
1148 (return)) 1147 (return))
1149 1148
1150 ;; localname. 1149 ;; localname.
1151 (if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-*$" line) 1150 (if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-*$" line)
1152 (setq localname (match-string 1 line)) 1151 (setq localname (match-string 1 line))
1162 '(0 0))) 1161 '(0 0)))
1163 (list localname mode size mtime)))) 1162 (list localname mode size mtime))))
1164 1163
1165 (defun tramp-smb-get-cifs-capabilities (vec) 1164 (defun tramp-smb-get-cifs-capabilities (vec)
1166 "Check, whether the SMB server supports POSIX commands." 1165 "Check, whether the SMB server supports POSIX commands."
1167 (with-connection-property 1166 ;; When we are not logged in yet, we return nil.
1168 (tramp-get-connection-process vec) "cifs-capabilities" 1167 (if (let ((p (tramp-get-connection-process vec)))
1169 (when (tramp-smb-send-command vec "posix") 1168 (and p (processp p) (memq (process-status p) '(run open))))
1170 (with-current-buffer (tramp-get-buffer vec) 1169 (with-connection-property
1171 (goto-char (point-min)) 1170 (tramp-get-connection-process vec) "cifs-capabilities"
1172 (when (re-search-forward "Server supports CIFS capabilities" nil t) 1171 (when (tramp-smb-send-command vec "posix")
1173 (member 1172 (with-current-buffer (tramp-get-buffer vec)
1174 "pathnames" 1173 (goto-char (point-min))
1175 (split-string 1174 (when (re-search-forward "Server supports CIFS capabilities" nil t)
1176 (buffer-substring 1175 (member
1177 (point) (tramp-compat-line-end-position)) nil t))))))) 1176 "pathnames"
1177 (split-string
1178 (buffer-substring
1179 (point) (tramp-compat-line-end-position)) nil t))))))))
1178 1180
1179 1181
1180 ;; Connection functions. 1182 ;; Connection functions.
1181 1183
1182 (defun tramp-smb-send-command (vec command) 1184 (defun tramp-smb-send-command (vec command)
1189 1191
1190 (defun tramp-smb-maybe-open-connection (vec) 1192 (defun tramp-smb-maybe-open-connection (vec)
1191 "Maybe open a connection to HOST, log in as USER, using `tramp-smb-program'. 1193 "Maybe open a connection to HOST, log in as USER, using `tramp-smb-program'.
1192 Does not do anything if a connection is already open, but re-opens the 1194 Does not do anything if a connection is already open, but re-opens the
1193 connection if a previous connection has died for some reason." 1195 connection if a previous connection has died for some reason."
1194 (let* ((share (tramp-smb-get-share (tramp-file-name-localname vec))) 1196 (let* ((share (tramp-smb-get-share vec))
1195 (buf (tramp-get-buffer vec)) 1197 (buf (tramp-get-buffer vec))
1196 (p (get-buffer-process buf))) 1198 (p (get-buffer-process buf)))
1197 1199
1198 ;; Check whether we still have the same smbclient version. 1200 ;; Check whether we still have the same smbclient version.
1199 ;; Otherwise, we must delete the connection cache, because 1201 ;; Otherwise, we must delete the connection cache, because
1207 "Cannot find command %s in %s" tramp-smb-program exec-path)) 1209 "Cannot find command %s in %s" tramp-smb-program exec-path))
1208 1210
1209 (let* ((default-directory (tramp-compat-temporary-file-directory)) 1211 (let* ((default-directory (tramp-compat-temporary-file-directory))
1210 (smbclient-version 1212 (smbclient-version
1211 (shell-command-to-string (concat tramp-smb-program " -V")))) 1213 (shell-command-to-string (concat tramp-smb-program " -V"))))
1212 (unless (string-equal 1214 (tramp-message vec 6 (concat tramp-smb-program " -V"))
1213 smbclient-version 1215 (tramp-message vec 6 "\n%s" smbclient-version)
1214 (tramp-get-connection-property vec "smbclient-version" "")) 1216 (if (string-match "[ \t\n\r]+\\'" smbclient-version)
1215 (when (tramp-get-connection-property vec "smbclient-version" nil) 1217 (setq smbclient-version
1216 (tramp-flush-directory-property vec "") 1218 (replace-match "" nil nil smbclient-version)))
1217 (tramp-flush-connection-property vec) 1219 (unless
1218 ); (setq buf (tramp-get-buffer vec))) 1220 (string-equal
1219 (tramp-set-connection-property 1221 smbclient-version
1220 vec "smbclient-version" smbclient-version)))) 1222 (tramp-get-connection-property
1223 vec "smbclient-version" smbclient-version))
1224 (tramp-flush-directory-property vec "")
1225 (tramp-flush-connection-property vec))
1226 (tramp-set-connection-property
1227 vec "smbclient-version" smbclient-version)))
1221 1228
1222 ;; If too much time has passed since last command was sent, look 1229 ;; If too much time has passed since last command was sent, look
1223 ;; whether there has been an error message; maybe due to 1230 ;; whether there has been an error message; maybe due to
1224 ;; connection timeout. 1231 ;; connection timeout.
1225 (with-current-buffer buf 1232 (with-current-buffer buf
1254 (port (tramp-file-name-port vec)) 1261 (port (tramp-file-name-port vec))
1255 args) 1262 args)
1256 1263
1257 (if share 1264 (if share
1258 (setq args (list (concat "//" real-host "/" share))) 1265 (setq args (list (concat "//" real-host "/" share)))
1259 (setq args (list "-L" real-host ))) 1266 (setq args (list "-g" "-L" real-host )))
1260 1267
1261 (if (not (zerop (length real-user))) 1268 (if (not (zerop (length real-user)))
1262 (setq args (append args (list "-U" real-user))) 1269 (setq args (append args (list "-U" real-user)))
1263 (setq args (append args (list "-N")))) 1270 (setq args (append args (list "-N"))))
1264 1271
1300 (with-current-buffer (tramp-get-connection-buffer vec) 1307 (with-current-buffer (tramp-get-connection-buffer vec)
1301 (goto-char (point-min)) 1308 (goto-char (point-min))
1302 (search-forward-regexp 1309 (search-forward-regexp
1303 "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]" nil t) 1310 "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]" nil t)
1304 (let ((smbserver-version (match-string 0))) 1311 (let ((smbserver-version (match-string 0)))
1305 (unless (string-equal 1312 (unless
1306 smbserver-version 1313 (string-equal
1307 (tramp-get-connection-property 1314 smbserver-version
1308 vec "smbserver-version" "")) 1315 (tramp-get-connection-property
1309 (when (tramp-get-connection-property 1316 vec "smbserver-version" smbserver-version))
1310 vec "smbserver-version" nil) 1317 (tramp-flush-directory-property vec "")
1311 (tramp-flush-directory-property vec "") 1318 (tramp-flush-connection-property vec))
1312 (tramp-flush-connection-property vec)) 1319 (tramp-set-connection-property
1313 (tramp-set-connection-property 1320 vec "smbserver-version" smbserver-version)))
1314 vec "smbserver-version" smbserver-version))))
1315 1321
1316 ;; Set chunksize. Otherwise, `tramp-send-string' might 1322 ;; Set chunksize. Otherwise, `tramp-send-string' might
1317 ;; try it itself. 1323 ;; try it itself.
1318 (tramp-set-connection-property p "smb-share" share) 1324 (tramp-set-connection-property p "smb-share" share)
1319 (tramp-set-connection-property p "chunksize" tramp-chunksize) 1325 (tramp-set-connection-property p "chunksize" tramp-chunksize)