From c2dc9732f76a0f90613519fd34f88df9dcba6c48 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 7 Oct 2009 11:31:21 +0000 Subject: [PATCH] * net/tramp-smb.el (tramp-smb-errors): Add error messages. (tramp-smb-file-name-handler-alist): Add handler for `copy-directory', `expand-file-name', `set-file-modes'. (tramp-smb-handle-copy-directory) (tramp-smb-handle-expand-file-name) (tramp-smb-handle-set-file-modes): New defuns. (tramp-smb-handle-copy-file): Handle KEPP-DATE. (tramp-smb-handle-file-attributes): Simplify check for retrieving entry. (tramp-smb-handle-insert-directory): Don't flush the cache. (tramp-smb-maybe-open-connection): Check for samba client and server versions. --- lisp/ChangeLog | 18 ++++ lisp/net/tramp-smb.el | 244 +++++++++++++++++++++++++++++++----------- 2 files changed, 201 insertions(+), 61 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 445aa4ad7d7..60181af667d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,21 @@ +2009-10-07 Michael Albinus + + * net/tramp-cache.el (tramp-flush-connection-property): Add trace + message. + + * net/tramp-smb.el (tramp-smb-errors): Add error messages. + (tramp-smb-file-name-handler-alist): Add handler for + `copy-directory', `expand-file-name', `set-file-modes'. + (tramp-smb-handle-copy-directory) + (tramp-smb-handle-expand-file-name) + (tramp-smb-handle-set-file-modes): New defuns. + (tramp-smb-handle-copy-file): Handle KEEP-DATE. + (tramp-smb-handle-file-attributes): Simplify check for retrieving + entry. + (tramp-smb-handle-insert-directory): Don't flush the cache. + (tramp-smb-maybe-open-connection): Check for samba client and + server versions. + 2009-10-07 Eli Zaretskii * emacs-lisp/autoload.el (batch-update-autoloads): Fix last change diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 48d015013c0..ff2a5d13cb7 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -68,11 +68,13 @@ ;; `regexp-opt' not possible because of first string. (mapconcat 'identity - '(;; Connection error / timeout + '(;; Connection error / timeout / unknown command. "Connection to \\S-+ failed" "Read from server failed, maybe it closed the connection" "Call timed out: server did not respond" - ;; Samba + "\\S-+: command not found" + "Server doesn't support UNIX CIFS calls" + ;; Samba. "ERRDOS" "ERRSRV" "ERRbadfile" @@ -82,7 +84,7 @@ "ERRnomem" "ERRnosuchshare" ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000), - ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003) + ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003). "NT_STATUS_ACCESS_DENIED" "NT_STATUS_ACCOUNT_LOCKED_OUT" "NT_STATUS_BAD_NETWORK_NAME" @@ -128,20 +130,22 @@ See `tramp-actions-before-shell' for more info.") ;; New handlers should be added here. (defconst tramp-smb-file-name-handler-alist '( - ;; `access-file' performed by default handler + ;; `access-file' performed by default handler. (add-name-to-file . tramp-smb-handle-copy-file) ;; we're on Windows, honey. - ;; `byte-compiler-base-file-name' performed by default handler + ;; `byte-compiler-base-file-name' performed by default handler. + (copy-directory . tramp-smb-handle-copy-directory) (copy-file . tramp-smb-handle-copy-file) (delete-directory . tramp-smb-handle-delete-directory) (delete-file . tramp-smb-handle-delete-file) - ;; `diff-latest-backup-file' performed by default handler + ;; `diff-latest-backup-file' performed by default handler. (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) + (directory-files-and-attributes + . tramp-smb-handle-directory-files-and-attributes) (dired-call-process . ignore) (dired-compress-file . ignore) (dired-uncache . tramp-handle-dired-uncache) - ;; `expand-file-name' not necessary because we cannot expand "~/" + (expand-file-name . tramp-smb-handle-expand-file-name) (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) @@ -155,17 +159,17 @@ See `tramp-actions-before-shell' for more info.") (file-name-completion . tramp-handle-file-name-completion) (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-name-sans-versions' performed by default handler. (file-newer-than-file-p . tramp-smb-handle-file-newer-than-file-p) (file-ownership-preserved-p . ignore) (file-readable-p . tramp-smb-handle-file-exists-p) (file-regular-p . tramp-handle-file-regular-p) (file-symlink-p . tramp-handle-file-symlink-p) - ;; `file-truename' performed by default handler + ;; `file-truename' performed by default handler. (file-writable-p . tramp-smb-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) - ;; `find-file-noselect' performed by default handler - ;; `get-file-buffer' performed by default handler + ;; `find-file-noselect' performed by default handler. + ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-smb-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) (load . tramp-handle-load) @@ -173,7 +177,8 @@ See `tramp-actions-before-shell' for more info.") (make-directory-internal . tramp-smb-handle-make-directory-internal) (make-symbolic-link . ignore) (rename-file . tramp-smb-handle-rename-file) - (set-file-modes . ignore) + (set-file-modes . tramp-smb-handle-set-file-modes) + (set-file-times . ignore) (set-visited-file-modtime . ignore) (shell-command . ignore) (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name) @@ -203,7 +208,50 @@ pass to the OPERATION." (cons 'tramp-smb-file-name-p 'tramp-smb-file-name-handler)) -;; File name primitives +;; File name primitives. + +(defun tramp-smb-handle-copy-directory + (dirname newname &optional keep-date parents) + "Like `copy-directory' for Tramp files." + (setq dirname (expand-file-name dirname) + newname (expand-file-name newname)) + (let ((t1 (tramp-tramp-file-p dirname)) + (t2 (tramp-tramp-file-p newname))) + (with-parsed-tramp-file-name (if t1 dirname newname) nil + (if (or (null t1) (null t2)) + ;; We can copy recursively. + (let ((prompt (tramp-smb-send-command v "prompt")) + (recurse (tramp-smb-send-command v "recurse"))) + (unless (file-directory-p newname) + (make-directory newname parents)) + (unwind-protect + (unless + (and + prompt recurse + (tramp-smb-send-command + v (format "cd \"%s\"" + (tramp-smb-get-localname localname t))) + (tramp-smb-send-command + v (format "lcd \"%s\"" (if t1 newname dirname))) + (if t1 + (tramp-smb-send-command v "mget *") + (tramp-smb-send-command v "mput *"))) + ;; Error. + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-min)) + (search-forward-regexp tramp-smb-errors nil t) + (tramp-error + v 'file-error + "%s `%s'" (match-string 0) (if t1 dirname newname)))) + ;; Always go home. + (tramp-smb-send-command v (format "cd \\")) + ;; Toggle prompt and recurse OFF. + (if prompt (tramp-smb-send-command v "prompt")) + (if recurse (tramp-smb-send-command v "recurse")))) + + ;; We must do it file-wise. + (tramp-run-real-handler + '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) @@ -247,7 +295,10 @@ PRESERVE-UID-GID is completely ignored." v (format "put %s \"%s\"" filename file)) (tramp-message v 0 "Copying file %s to file %s...done" filename newname) - (tramp-error v 'file-error "Cannot copy `%s'" filename))))))) + (tramp-error v 'file-error "Cannot copy `%s'" filename)))))) + + ;; KEEP-DATE handling. + (when keep-date (set-file-times newname (nth 5 (file-attributes filename))))) (defun tramp-smb-handle-delete-directory (directory &optional recursive) "Like `delete-directory' for Tramp files." @@ -273,13 +324,13 @@ PRESERVE-UID-GID is completely ignored." (unless (and (tramp-smb-send-command v (format "cd \"%s\"" dir)) (tramp-smb-send-command v (format "rmdir \"%s\"" file))) - ;; Error + ;; Error. (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) (search-forward-regexp tramp-smb-errors nil t) (tramp-error v 'file-error "%s `%s'" (match-string 0) directory))) - ;; Always go home + ;; Always go home. (tramp-smb-send-command v (format "cd \\"))))))) (defun tramp-smb-handle-delete-file (filename) @@ -297,13 +348,13 @@ PRESERVE-UID-GID is completely ignored." (unless (and (tramp-smb-send-command v (format "cd \"%s\"" dir)) (tramp-smb-send-command v (format "rm \"%s\"" file))) - ;; Error + ;; Error. (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) (search-forward-regexp tramp-smb-errors nil t) (tramp-error v 'file-error "%s `%s'" (match-string 0) filename))) - ;; Always go home + ;; Always go home. (tramp-smb-send-command v (format "cd \\"))))))) (defun tramp-smb-handle-directory-files @@ -311,21 +362,21 @@ PRESERVE-UID-GID is completely ignored." "Like `directory-files' for Tramp files." (let ((result (mapcar 'directory-file-name (file-name-all-completions "" directory)))) - ;; Discriminate with regexp + ;; Discriminate with regexp. (when match (setq result (delete nil (mapcar (lambda (x) (when (string-match match x) x)) result)))) - ;; Append directory + ;; Append directory. (when full (setq result (mapcar (lambda (x) (expand-file-name x directory)) result))) - ;; Sort them if necessary + ;; Sort them if necessary. (unless nosort (setq result (sort result 'string-lessp))) - ;; That's it + ;; That's it. result)) (defun tramp-smb-handle-directory-files-and-attributes @@ -337,6 +388,35 @@ PRESERVE-UID-GID is completely ignored." (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 "/". + (setq dir (or dir default-directory "/")) + ;; Unless NAME is absolute, concat DIR and NAME. + (unless (file-name-absolute-p name) + (setq name (concat (file-name-as-directory dir) name))) + ;; If NAME is not a Tramp file, run the real handler. + (if (not (tramp-tramp-file-p name)) + (tramp-run-real-handler 'expand-file-name (list name nil)) + ;; Dissect NAME. + (with-parsed-tramp-file-name name nil + (unless (tramp-run-real-handler 'file-name-absolute-p (list localname)) + (setq localname (concat "/" localname))) + ;; Tilde expansion if necessary. We use the user name as share, + ;; which is offen the case in work groups. + (when (string-match "\\`~[^/]*" localname) + (setq localname + (replace-match + (if (zerop (length (match-string 0 localname))) + (tramp-file-name-real-user v) + (match-string 0 localname)) + nil nil localname))) + ;; No tilde characters in file name, do normal + ;; `expand-file-name' (this does "/./" and "/../"). + (tramp-make-tramp-file-name + method user host + (tramp-run-real-handler 'expand-file-name (list localname)))))) + (defun tramp-smb-handle-file-attributes (filename &optional id-format) "Like `file-attributes' for Tramp files." ;; Reading just the filename entry via "dir localname" is not @@ -348,8 +428,7 @@ PRESERVE-UID-GID is completely ignored." (with-file-property v localname (format "file-attributes-%s" id-format) (let* ((entries (tramp-smb-get-file-entries (file-name-directory filename))) - (entry (and entries - (assoc (file-name-nondirectory filename) entries))) + (entry (assoc (file-name-nondirectory filename) entries)) (uid (if (and id-format (equal id-format 'string)) "nobody" -1)) (gid (if (and id-format (equal id-format 'string)) "nogroup" -1)) (inode (tramp-get-inode v)) @@ -442,7 +521,6 @@ PRESERVE-UID-GID is completely ignored." ;; Called from `dired-add-entry'. (setq filename (file-name-as-directory filename))) (with-parsed-tramp-file-name filename nil - (tramp-flush-file-property v (file-name-directory localname)) (save-match-data (let ((base (file-name-nondirectory filename)) ;; We should not destroy the cache entry. @@ -527,10 +605,10 @@ PRESERVE-UID-GID is completely ignored." (save-match-data (let* ((share (tramp-smb-get-share localname)) (ldir (file-name-directory dir))) - ;; Make missing directory parts + ;; Make missing directory parts. (when (and parents share (not (file-directory-p ldir))) (make-directory ldir parents)) - ;; Just do it + ;; Just do it. (when (file-directory-p ldir) (make-directory-internal dir)) (unless (file-directory-p dir) @@ -592,6 +670,17 @@ PRESERVE-UID-GID is completely ignored." (delete-file filename)) +(defun tramp-smb-handle-set-file-modes (filename mode) + "Like `set-file-modes' for Tramp files." + (with-parsed-tramp-file-name filename nil + (tramp-flush-file-property v localname) + (unless (tramp-smb-send-command + v (format "chmod \"%s\" %s" + (tramp-smb-get-localname localname t) + (tramp-decimal-to-octal mode))) + (tramp-error + v 'file-error "Error while changing file's mode %s" filename)))) + (defun tramp-smb-handle-substitute-in-file-name (filename) "Like `handle-substitute-in-file-name' for Tramp files. \"//\" substitutes only in the local filename part. Catches @@ -652,7 +741,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." (set-visited-file-modtime))))) -;; Internal file name functions +;; Internal file name functions. (defun tramp-smb-get-share (localname) "Returns the share name of LOCALNAME." @@ -677,7 +766,7 @@ If CONVERT is non-nil exchange \"/\" by \"\\\\\"." (match-string 1 res) ""))) - ;; Sometimes we have discarded `substitute-in-file-name' + ;; Sometimes we have discarded `substitute-in-file-name'. (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" res) (setq res (replace-match "$" nil nil res 1))) @@ -699,19 +788,19 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)." res entry) (if (and (not share) cache) - ;; Return cached shares + ;; Return cached shares. (setq res cache) - ;; Read entries + ;; Read entries. (setq file (file-name-as-directory file)) (when (string-match "^\\./" file) (setq file (substring file 1))) (if share (tramp-smb-send-command v (format "dir \"%s*\"" file)) - ;; `tramp-smb-maybe-open-connection' lists also the share names + ;; `tramp-smb-maybe-open-connection' lists also the share names. (tramp-smb-maybe-open-connection v)) - ;; Loop the listing + ;; Loop the listing. (goto-char (point-min)) (unless (re-search-forward tramp-smb-errors nil t) (while (not (eobp)) @@ -719,23 +808,23 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)." (forward-line) (when entry (add-to-list 'res entry)))) - ;; Cache share entries + ;; Cache share entries. (unless share (tramp-set-connection-property v "share-cache" res))) - ;; Add directory itself + ;; Add directory itself. (add-to-list 'res '("" "drwxrwxrwx" 0 (0 0))) ;; There's a very strange error (debugged with XEmacs 21.4.14) ;; If there's no short delay, it returns nil. No idea about. (when (featurep 'xemacs) (sleep-for 0.01)) - ;; Return entries + ;; Return entries. (delq nil res)))))) -;; Return either a share name (if SHARE is nil), or a file name +;; Return either a share name (if SHARE is nil), or a file name. ;; -;; If shares are listed, the following format is expected +;; If shares are listed, the following format is expected: ;; ;; \s-\{8,8} - leading spaces ;; \S-\(.*\S-\)\s-* - share name, 14 char @@ -807,13 +896,13 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." ;; Real listing. (block nil - ;; year + ;; year. (if (string-match "\\([0-9]+\\)$" line) (setq year (string-to-number (match-string 1 line)) line (substring line 0 -5)) (return)) - ;; time + ;; time. (if (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)$" line) (setq hour (string-to-number (match-string 1 line)) min (string-to-number (match-string 2 line)) @@ -821,24 +910,24 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." line (substring line 0 -9)) (return)) - ;; day + ;; day. (if (string-match "\\([0-9]+\\)$" line) (setq day (string-to-number (match-string 1 line)) line (substring line 0 -3)) (return)) - ;; month + ;; month. (if (string-match "\\(\\w+\\)$" line) (setq month (match-string 1 line) line (substring line 0 -4)) (return)) - ;; weekday + ;; weekday. (if (string-match "\\(\\w+\\)$" line) (setq line (substring line 0 -5)) (return)) - ;; size + ;; size. (if (string-match "\\([0-9]+\\)$" line) (let ((length (- (max 10 (1+ (length (match-string 1 line))))))) (setq size (string-to-number (match-string 1 line))) @@ -847,7 +936,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." (setq line (substring line 0 length))) (return)) - ;; mode: ARCH, DIR, HIDDEN, RONLY, SYSTEM, VOLID + ;; mode: ARCH, DIR, HIDDEN, RONLY, SYSTEM, VOLID. (if (string-match "\\([ADHRSV]+\\)?$" line) (setq mode (or (match-string 1 line) "") @@ -860,7 +949,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." line (substring line 0 -7)) (return)) - ;; localname + ;; localname. (if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-*$" line) (setq localname (match-string 1 line)) (return)))) @@ -876,7 +965,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." (list localname mode size mtime)))) -;; Connection functions +;; Connection functions. (defun tramp-smb-send-command (vec command) "Send the COMMAND to connection VEC. @@ -894,8 +983,32 @@ connection if a previous connection has died for some reason." (buf (tramp-get-buffer vec)) (p (get-buffer-process buf))) + ;; Check whether we still have the same smbclient version. + ;; 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")))) + (unless (string-equal + smbclient-version + (tramp-get-connection-property vec "smbclient-version" "")) + (tramp-flush-directory-property vec "") + (tramp-flush-connection-property vec) + (tramp-set-connection-property + vec "smbclient-version" smbclient-version) + (setq buf (tramp-get-buffer vec))))) + ;; If too much time has passed since last command was sent, look - ;; whether has been an error message; maybe due to connection timeout. + ;; whether there has been an error message; maybe due to + ;; connection timeout. (with-current-buffer buf (goto-char (point-min)) (when (and (> (tramp-time-diff @@ -920,11 +1033,6 @@ connection if a previous connection has died for some reason." (when buf (with-current-buffer buf (erase-buffer))) (when (and p (processp p)) (delete-process p)) - (unless (let ((default-directory - (tramp-compat-temporary-file-directory))) - (executable-find tramp-smb-program)) - (error "Cannot find command %s in %s" tramp-smb-program exec-path)) - (let* ((user (tramp-file-name-user vec)) (host (tramp-file-name-host vec)) (real-user (tramp-file-name-real-user vec)) @@ -962,17 +1070,12 @@ connection if a previous connection has died for some reason." (tramp-message vec 6 "%s" (mapconcat 'identity (process-command p) " ")) (tramp-set-process-query-on-exit-flag p nil) - (tramp-set-connection-property p "smb-share" share) ;; Set variables for computing the prompt for reading password. (setq tramp-current-method tramp-smb-method tramp-current-user user tramp-current-host host) - ;; Set chunksize. Otherwise, `tramp-send-string' might - ;; try it itself. - (tramp-set-connection-property p "chunksize" tramp-chunksize) - ;; Play login scenario. (tramp-process-actions p vec @@ -980,6 +1083,26 @@ connection if a previous connection has died for some reason." 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))) + (when (not (string-equal + smbserver-version + (tramp-get-connection-property + vec "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 "@") "") @@ -1033,8 +1156,7 @@ Returns nil if an error message has appeared." ;; * Error handling in case password is wrong. ;; * Read password from "~/.netrc". -;; * Return more comprehensive file permission string. Think whether it is -;; possible to implement `set-file-modes'. +;; * Return more comprehensive file permission string. ;; * Handle links (FILENAME.LNK). ;; * Try to remove the inclusion of dummy "" directory. Seems to be at ;; several places, especially in `tramp-smb-handle-insert-directory'. -- 2.39.2