X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/4260b4027e1eff71cf7f1f6b42d163c94e40a5e4..4628bef1eea0f60e846fe6b6591725aa92952de9:/lisp/net/tramp-smb.el diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index d09909f330..d230821682 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1,10 +1,11 @@ ;;; tramp-smb.el --- Tramp access functions for SMB servers ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, -;; 2009 Free Software Foundation, Inc. +;; 2009, 2010 Free Software Foundation, Inc. ;; Author: Michael Albinus ;; Keywords: comm, processes +;; Package: tramp ;; This file is part of GNU Emacs. @@ -29,17 +30,16 @@ (eval-when-compile (require 'cl)) ; block, return (require 'tramp) -(require 'tramp-cache) -(require 'tramp-compat) ;; Define SMB method ... -(defcustom tramp-smb-method "smb" - "*Method to connect SAMBA and M$ SMB servers." - :group 'tramp - :type 'string) +;;;###tramp-autoload +(defconst tramp-smb-method "smb" + "*Method to connect SAMBA and M$ SMB servers.") ;; ... and add it to the method list. -(add-to-list 'tramp-methods (cons tramp-smb-method nil)) +;;;###tramp-autoload +(unless (memq system-type '(cygwin windows-nt)) + (add-to-list 'tramp-methods (cons tramp-smb-method nil))) ;; Add a default for `tramp-default-method-alist'. Rule: If there is ;; a domain in USER, it must be the SMB method. @@ -61,6 +61,16 @@ :group 'tramp :type 'string) +(defcustom tramp-smb-conf "/dev/null" + "*Path of the smb.conf file. +If it is nil, no smb.conf will be added to the `tramp-smb-program' +call, letting the SMB client use the default one." + :group 'tramp + :type '(choice (const nil) (file :must-match t))) + +(defvar tramp-smb-version nil + "*Version string of the SMB client.") + (defconst tramp-smb-prompt "^smb: .+> \\|^\\s-+Server\\s-+Comment$" "Regexp used as prompt in smbclient.") @@ -143,7 +153,7 @@ See `tramp-actions-before-shell' for more info.") (directory-file-name . tramp-handle-directory-file-name) (directory-files . tramp-smb-handle-directory-files) (directory-files-and-attributes - . tramp-smb-handle-directory-files-and-attributes) + . tramp-handle-directory-files-and-attributes) (dired-call-process . ignore) (dired-compress-file . ignore) (dired-uncache . tramp-handle-dired-uncache) @@ -151,10 +161,9 @@ See `tramp-actions-before-shell' for more info.") (file-accessible-directory-p . tramp-smb-handle-file-directory-p) (file-attributes . tramp-smb-handle-file-attributes) (file-directory-p . tramp-smb-handle-file-directory-p) - (file-executable-p . tramp-smb-handle-file-exists-p) - (file-exists-p . tramp-smb-handle-file-exists-p) + (file-executable-p . tramp-handle-file-exists-p) + (file-exists-p . tramp-handle-file-exists-p) (file-local-copy . tramp-smb-handle-file-local-copy) - (file-remote-p . tramp-handle-file-remote-p) (file-modes . tramp-handle-file-modes) (file-name-all-completions . tramp-smb-handle-file-name-all-completions) (file-name-as-directory . tramp-handle-file-name-as-directory) @@ -162,10 +171,12 @@ See `tramp-actions-before-shell' for more info.") (file-name-directory . tramp-handle-file-name-directory) (file-name-nondirectory . tramp-handle-file-name-nondirectory) ;; `file-name-sans-versions' performed by default handler. - (file-newer-than-file-p . tramp-smb-handle-file-newer-than-file-p) + (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) (file-ownership-preserved-p . ignore) - (file-readable-p . tramp-smb-handle-file-exists-p) + (file-readable-p . tramp-handle-file-exists-p) (file-regular-p . tramp-handle-file-regular-p) + (file-remote-p . tramp-handle-file-remote-p) + ;; `file-selinux-context' performed by default handler. (file-symlink-p . tramp-handle-file-symlink-p) ;; `file-truename' performed by default handler. (file-writable-p . tramp-smb-handle-file-writable-p) @@ -180,6 +191,7 @@ See `tramp-actions-before-shell' for more info.") (make-symbolic-link . tramp-smb-handle-make-symbolic-link) (rename-file . tramp-smb-handle-rename-file) (set-file-modes . tramp-smb-handle-set-file-modes) + ;; `set-file-selinux-context' performed by default handler. (set-file-times . ignore) (set-visited-file-modtime . ignore) (shell-command . ignore) @@ -192,11 +204,13 @@ See `tramp-actions-before-shell' for more info.") "Alist of handler functions for Tramp SMB method. Operations not mentioned here will be handled by the default Emacs primitives.") -(defun tramp-smb-file-name-p (filename) +;;;###tramp-autoload +(defsubst tramp-smb-file-name-p (filename) "Check if it's a filename for SMB servers." (let ((v (tramp-dissect-file-name filename))) (string= (tramp-file-name-method v) tramp-smb-method))) +;;;###tramp-autoload (defun tramp-smb-file-name-handler (operation &rest args) "Invoke the SMB related OPERATION. First arg specifies the OPERATION, second arg is a list of arguments to @@ -206,8 +220,10 @@ pass to the OPERATION." (save-match-data (apply (cdr fn) args)) (tramp-run-real-handler operation args)))) -(add-to-list 'tramp-foreign-file-name-handler-alist - (cons 'tramp-smb-file-name-p 'tramp-smb-file-name-handler)) +;;;###tramp-autoload +(unless (memq system-type '(cygwin windows-nt)) + (add-to-list 'tramp-foreign-file-name-handler-alist + (cons 'tramp-smb-file-name-p 'tramp-smb-file-name-handler))) ;; File name primitives. @@ -273,9 +289,9 @@ pass to the OPERATION." (tramp-compat-temporary-file-directory))))) (unwind-protect (progn - (copy-directory dirname tmpdir keep-date parents) - (copy-directory tmpdir newname keep-date parents)) - (delete-directory tmpdir 'recursive)))) + (tramp-compat-copy-directory dirname tmpdir keep-date parents) + (tramp-compat-copy-directory tmpdir newname keep-date parents)) + (tramp-compat-delete-directory tmpdir 'recursive)))) ;; We can copy recursively. ((or t1 t2) @@ -315,47 +331,48 @@ pass to the OPERATION." 'copy-directory (list dirname newname keep-date parents))))))) (defun tramp-smb-handle-copy-file - (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid) + (filename newname &optional ok-if-already-exists keep-date + preserve-uid-gid preserve-selinux-context) "Like `copy-file' for Tramp files. 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) + (delete-file tmpfile) + (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) - (delete-file tmpfile) - (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))))) @@ -368,7 +385,7 @@ PRESERVE-UID-GID is completely ignored." (mapc (lambda (file) (if (file-directory-p file) - (delete-directory file recursive) + (tramp-compat-delete-directory file recursive) (delete-file file))) ;; We do not want to delete "." and "..". (directory-files @@ -391,7 +408,7 @@ PRESERVE-UID-GID is completely ignored." (tramp-error v 'file-error "%s `%s'" (match-string 0) directory)))))) -(defun tramp-smb-handle-delete-file (filename) +(defun tramp-smb-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." (setq filename (expand-file-name filename)) (when (file-exists-p filename) @@ -434,15 +451,6 @@ PRESERVE-UID-GID is completely ignored." ;; That's it. result)) -(defun tramp-smb-handle-directory-files-and-attributes - (directory &optional full match nosort id-format) - "Like `directory-files-and-attributes' for Tramp files." - (mapcar - (lambda (x) - (cons x (tramp-compat-file-attributes - (if full x (expand-file-name x directory)) id-format))) - (directory-files directory full match nosort))) - (defun tramp-smb-handle-expand-file-name (name &optional dir) "Like `expand-file-name' for Tramp files." ;; If DIR is not given, use DEFAULT-DIRECTORY or "/". @@ -478,7 +486,7 @@ PRESERVE-UID-GID is completely ignored." (unless id-format (setq id-format 'integer)) (with-parsed-tramp-file-name filename nil (with-file-property v localname (format "file-attributes-%s" id-format) - (if (and (tramp-smb-get-share v) (tramp-smb-get-cifs-capabilities v)) + (if (and (tramp-smb-get-share v) (tramp-smb-get-stat-capability v)) (tramp-smb-do-file-attributes-with-stat v id-format) ;; Reading just the filename entry via "dir localname" is not ;; possible, because when filename is a directory, some @@ -516,81 +524,70 @@ PRESERVE-UID-GID is completely ignored." vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec)) (with-current-buffer (tramp-get-buffer vec) (let* (size id link uid gid atime mtime ctime mode inode) - (unless - (tramp-smb-send-command - vec (format "stat \"%s\"" (tramp-smb-get-localname vec))) - ;; Error. - (with-current-buffer (tramp-get-connection-buffer vec) - (goto-char (point-min)) - (search-forward-regexp tramp-smb-errors nil t) - (tramp-error - vec 'file-error "%s" (match-string 0)))) + (when (tramp-smb-send-command + vec (format "stat \"%s\"" (tramp-smb-get-localname vec))) - ;; Loop the listing. - (goto-char (point-min)) - (unless (re-search-forward tramp-smb-errors nil t) - (while (not (eobp)) - (cond - ((looking-at - "Size:\\s-+\\([0-9]+\\)\\s-+Blocks:\\s-+[0-9]+\\s-+\\(\\w+\\)") - (setq size (string-to-number (match-string 1)) - id (if (string-equal "directory" (match-string 2)) t - (if (string-equal "symbolic" (match-string 2)) "")))) - ((looking-at - "Inode:\\s-+\\([0-9]+\\)\\s-+Links:\\s-+\\([0-9]+\\)") - (setq inode (string-to-number (match-string 1)) - link (string-to-number (match-string 2)))) - ((looking-at - "Access:\\s-+([0-9]+/\\(\\S-+\\))\\s-+Uid:\\s-+\\([0-9]+\\)\\s-+Gid:\\s-+\\([0-9]+\\)") - (setq mode (match-string 1) - uid (if (equal id-format 'string) (match-string 2) - (string-to-number (match-string 2))) - gid (if (equal id-format 'string) (match-string 3) - (string-to-number (match-string 3))))) - ((looking-at - "Access:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)") - (setq atime - (encode-time - (string-to-number (match-string 6)) ;; sec - (string-to-number (match-string 5)) ;; min - (string-to-number (match-string 4)) ;; hour - (string-to-number (match-string 3)) ;; day - (string-to-number (match-string 2)) ;; month - (string-to-number (match-string 1))))) ;; year - ((looking-at - "Modify:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)") - (setq mtime - (encode-time - (string-to-number (match-string 6)) ;; sec - (string-to-number (match-string 5)) ;; min - (string-to-number (match-string 4)) ;; hour - (string-to-number (match-string 3)) ;; day - (string-to-number (match-string 2)) ;; month - (string-to-number (match-string 1))))) ;; year - ((looking-at - "Change:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)") - (setq ctime - (encode-time - (string-to-number (match-string 6)) ;; sec - (string-to-number (match-string 5)) ;; min - (string-to-number (match-string 4)) ;; hour - (string-to-number (match-string 3)) ;; day - (string-to-number (match-string 2)) ;; month - (string-to-number (match-string 1)))))) ;; year - (forward-line)) - ;; Return the result. - (list id link uid gid atime mtime ctime size mode nil inode - (tramp-get-device vec)))))) + ;; Loop the listing. + (goto-char (point-min)) + (unless (re-search-forward tramp-smb-errors nil t) + (while (not (eobp)) + (cond + ((looking-at + "Size:\\s-+\\([0-9]+\\)\\s-+Blocks:\\s-+[0-9]+\\s-+\\(\\w+\\)") + (setq size (string-to-number (match-string 1)) + id (if (string-equal "directory" (match-string 2)) t + (if (string-equal "symbolic" (match-string 2)) "")))) + ((looking-at + "Inode:\\s-+\\([0-9]+\\)\\s-+Links:\\s-+\\([0-9]+\\)") + (setq inode (string-to-number (match-string 1)) + link (string-to-number (match-string 2)))) + ((looking-at + "Access:\\s-+([0-9]+/\\(\\S-+\\))\\s-+Uid:\\s-+\\([0-9]+\\)\\s-+Gid:\\s-+\\([0-9]+\\)") + (setq mode (match-string 1) + uid (if (equal id-format 'string) (match-string 2) + (string-to-number (match-string 2))) + gid (if (equal id-format 'string) (match-string 3) + (string-to-number (match-string 3))))) + ((looking-at + "Access:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)") + (setq atime + (encode-time + (string-to-number (match-string 6)) ;; sec + (string-to-number (match-string 5)) ;; min + (string-to-number (match-string 4)) ;; hour + (string-to-number (match-string 3)) ;; day + (string-to-number (match-string 2)) ;; month + (string-to-number (match-string 1))))) ;; year + ((looking-at + "Modify:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)") + (setq mtime + (encode-time + (string-to-number (match-string 6)) ;; sec + (string-to-number (match-string 5)) ;; min + (string-to-number (match-string 4)) ;; hour + (string-to-number (match-string 3)) ;; day + (string-to-number (match-string 2)) ;; month + (string-to-number (match-string 1))))) ;; year + ((looking-at + "Change:\\s-+\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)") + (setq ctime + (encode-time + (string-to-number (match-string 6)) ;; sec + (string-to-number (match-string 5)) ;; min + (string-to-number (match-string 4)) ;; hour + (string-to-number (match-string 3)) ;; day + (string-to-number (match-string 2)) ;; month + (string-to-number (match-string 1)))))) ;; year + (forward-line)) + ;; Return the result. + (list id link uid gid atime mtime ctime size mode nil inode + (tramp-get-device vec))))))) (defun tramp-smb-handle-file-directory-p (filename) "Like `file-directory-p' for Tramp files." (and (file-exists-p filename) (eq ?d (aref (nth 8 (file-attributes filename)) 0)))) -(defun tramp-smb-handle-file-exists-p (filename) - "Like `file-exists-p' for Tramp files." - (not (null (file-attributes filename)))) - (defun tramp-smb-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." (with-parsed-tramp-file-name filename nil @@ -599,15 +596,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. - (delete-file tmpfile) - (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. + (delete-file tmpfile) + (tramp-error + v 'file-error "Cannot make local copy of file `%s'" filename))) tmpfile))) ;; This function should return "foo/" for directories and "bar" for @@ -628,14 +625,6 @@ PRESERVE-UID-GID is completely ignored." (nth 0 x)))) entries))))))) -(defun tramp-smb-handle-file-newer-than-file-p (file1 file2) - "Like `file-newer-than-file-p' for Tramp files." - (cond - ((not (file-exists-p file1)) nil) - ((not (file-exists-p file2)) t) - (t (tramp-time-less-p (nth 5 (file-attributes file2)) - (nth 5 (file-attributes file1)))))) - (defun tramp-smb-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." (if (file-exists-p filename) @@ -648,9 +637,10 @@ PRESERVE-UID-GID is completely ignored." (filename switches &optional wildcard full-directory-p) "Like `insert-directory' for Tramp files." (setq filename (expand-file-name filename)) - (when full-directory-p - ;; Called from `dired-add-entry'. - (setq filename (file-name-as-directory filename))) + (if full-directory-p + ;; Called from `dired-add-entry'. + (setq filename (file-name-as-directory filename)) + (setq filename (directory-file-name filename))) (with-parsed-tramp-file-name filename nil (save-match-data (let ((base (file-name-nondirectory filename)) @@ -706,30 +696,39 @@ PRESERVE-UID-GID is completely ignored." entries)) ;; Print entries. - (mapcar + (mapc (lambda (x) (when (not (zerop (length (nth 0 x)))) (let ((attr - (when (tramp-smb-get-cifs-capabilities v) + (when (tramp-smb-get-stat-capability v) (ignore-errors - (file-attributes - (expand-file-name (nth 0 x)) 'string))))) + (file-attributes filename 'string))))) (insert (format - "%10s %3d %-8s %-8s %8s %s %s\n" + "%10s %3d %-8s %-8s %8s %s " (or (nth 8 attr) (nth 1 x)) ; mode - (or (nth 1 attr) 1) ; link + (or (nth 1 attr) 1) ; inode (or (nth 2 attr) "nobody") ; uid (or (nth 3 attr) "nogroup") ; gid - (nth 2 x) ; size + (or (nth 7 attr) (nth 2 x)) ; size (format-time-string (if (tramp-time-less-p (tramp-time-subtract (current-time) (nth 3 x)) tramp-half-a-year) "%b %e %R" "%b %e %Y") - (nth 3 x)) ; date - (nth 0 x))) ; file name + (nth 3 x)))) ; date + ;; We mark the file name. The inserted name could be + ;; from somewhere else, so we use the relative file + ;; name of `default-directory'. + (let ((start (point))) + (insert + (format + "%s\n" + (file-relative-name + (expand-file-name + (nth 0 x) (file-name-directory filename))))) + (put-text-property start (1- (point)) 'dired-filename t)) (forward-line) (beginning-of-line)))) entries))))) @@ -767,7 +766,7 @@ PRESERVE-UID-GID is completely ignored." (if (tramp-smb-get-cifs-capabilities v) (format "posix_mkdir \"%s\" %s" - file (tramp-decimal-to-octal (default-file-modes))) + file (tramp-compat-decimal-to-octal (default-file-modes))) (format "mkdir \"%s\"" file))) ;; We must also flush the cache of the directory, because ;; `file-attributes' reads the values from there. @@ -834,38 +833,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) + (delete-file tmpfile) + (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) - (delete-file tmpfile) - (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))))) - - (delete-file filename)) + (delete-file filename))) (defun tramp-smb-handle-set-file-modes (filename mode) "Like `set-file-modes' for Tramp files." @@ -875,7 +875,7 @@ target of the symlink differ." (unless (tramp-smb-send-command v (format "chmod \"%s\" %s" (tramp-smb-get-localname v) - (tramp-decimal-to-octal mode))) + (tramp-compat-decimal-to-octal mode))) (tramp-error v 'file-error "Error while changing file's mode %s" filename))))) @@ -922,14 +922,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)) - (delete-file tmpfile)) + (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)) + (delete-file tmpfile))) (unless (equal curbuf (current-buffer)) (tramp-error @@ -1168,15 +1168,26 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." (and p (processp p) (memq (process-status p) '(run open)))) (with-connection-property (tramp-get-connection-process vec) "cifs-capabilities" - (when (tramp-smb-send-command vec "posix") - (with-current-buffer (tramp-get-buffer vec) - (goto-char (point-min)) - (when (re-search-forward "Server supports CIFS capabilities" nil t) - (member - "pathnames" - (split-string - (buffer-substring - (point) (tramp-compat-line-end-position)) nil t)))))))) + (save-match-data + (when (tramp-smb-send-command vec "posix") + (with-current-buffer (tramp-get-buffer vec) + (goto-char (point-min)) + (when + (re-search-forward "Server supports CIFS capabilities" nil t) + (member + "pathnames" + (split-string + (buffer-substring + (point) (tramp-compat-line-end-position)) nil t))))))))) + +(defun tramp-smb-get-stat-capability (vec) + "Check, whether the SMB server supports the STAT command." + ;; When we are not logged in yet, we return nil. + (if (let ((p (tramp-get-connection-process vec))) + (and p (processp p) (memq (process-status p) '(run open)))) + (with-connection-property + (tramp-get-connection-process vec) "stat-capability" + (tramp-smb-send-command vec "stat .")))) ;; Connection functions. @@ -1201,30 +1212,30 @@ connection if a previous connection has died for some reason." ;; Otherwise, we must delete the connection cache, because ;; capabilities migh have changed. (unless (processp p) - (unless (let ((default-directory - (tramp-compat-temporary-file-directory))) - (executable-find tramp-smb-program)) - (tramp-error - vec 'file-error - "Cannot find command %s in %s" tramp-smb-program exec-path)) - - (let* ((default-directory (tramp-compat-temporary-file-directory)) - (smbclient-version - (shell-command-to-string (concat tramp-smb-program " -V")))) - (tramp-message vec 6 (concat tramp-smb-program " -V")) - (tramp-message vec 6 "\n%s" smbclient-version) - (if (string-match "[ \t\n\r]+\\'" smbclient-version) - (setq smbclient-version - (replace-match "" nil nil smbclient-version))) - (unless - (string-equal - smbclient-version - (tramp-get-connection-property - vec "smbclient-version" smbclient-version)) + (let ((default-directory (tramp-compat-temporary-file-directory)) + (command (concat tramp-smb-program " -V"))) + + (unless tramp-smb-version + (unless (executable-find tramp-smb-program) + (tramp-error + vec 'file-error + "Cannot find command %s in %s" tramp-smb-program exec-path)) + (setq tramp-smb-version (shell-command-to-string command)) + (tramp-message vec 6 command) + (tramp-message vec 6 "\n%s" tramp-smb-version) + (if (string-match "[ \t\n\r]+\\'" tramp-smb-version) + (setq tramp-smb-version + (replace-match "" nil nil tramp-smb-version)))) + + (unless (string-equal + tramp-smb-version + (tramp-get-connection-property + vec "smbclient-version" tramp-smb-version)) (tramp-flush-directory-property vec "") (tramp-flush-connection-property vec)) + (tramp-set-connection-property - vec "smbclient-version" smbclient-version))) + vec "smbclient-version" tramp-smb-version))) ;; If too much time has passed since last command was sent, look ;; whether there has been an error message; maybe due to @@ -1271,63 +1282,61 @@ connection if a previous connection has died for some reason." (when domain (setq args (append args (list "-W" domain)))) (when port (setq args (append args (list "-p" port)))) - (setq args (append args (list "-s" "/dev/null"))) + (when tramp-smb-conf + (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-compat-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) @@ -1370,6 +1379,9 @@ Returns nil if an error message has appeared." (tramp-message vec 6 "\n%s" (buffer-string)) (not err)))) +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-smb 'force))) (provide 'tramp-smb)