X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/a338b7a70881174039ad488d7950041175dad9d0..65e86587ab836aaa86b12ce30b219bcb4fcbaa06:/lisp/net/tramp-smb.el diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 781814a9d5..34bb388f85 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1,8 +1,8 @@ ;;; tramp-smb.el --- Tramp access functions for SMB servers -*- coding: iso-8859-1; -*- -;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. -;; Author: Michael Albinus +;; Author: Michael Albinus ;; Keywords: comm, processes ;; This file is part of GNU Emacs. @@ -19,8 +19,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -46,11 +46,6 @@ (defalias 'warnings 'identity) ; Pacify Emacs byte-compiler (byte-compiler-options (warnings (- unused-vars)))))) -;; XEmacs byte-compiler raises warning abouts `last-coding-system-used'. -(eval-when-compile - (unless (boundp 'last-coding-system-used) - (defvar last-coding-system-used nil))) - ;; Define SMB method ... (defcustom tramp-smb-method "smb" "*Method to connect SAMBA and M$ SMB servers." @@ -75,7 +70,7 @@ :group 'tramp :type 'string) -(defconst tramp-smb-prompt "^smb: \\S-+> \\|^\\s-+Server\\s-+Comment$" +(defconst tramp-smb-prompt "^smb: .+> \\|^\\s-+Server\\s-+Comment$" "Regexp used as prompt in smbclient.") (defconst tramp-smb-errors @@ -144,6 +139,7 @@ This variable is local to each buffer.") (file-executable-p . tramp-smb-handle-file-exists-p) (file-exists-p . tramp-smb-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' performed by default handler @@ -171,7 +167,7 @@ This variable is local to each buffer.") (set-file-modes . tramp-smb-not-handled) (set-visited-file-modtime . tramp-smb-not-handled) (shell-command . tramp-smb-not-handled) - ;; `substitute-in-file-name' performed by default handler + (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name) (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) (vc-registered . tramp-smb-not-handled) (verify-visited-file-modtime . tramp-smb-not-handled) @@ -234,10 +230,7 @@ KEEP-DATE is not handled in case NEWNAME resides on an SMB server." (file-exists-p newname)) (error "copy-file: file %s already exists" newname)) -; (with-parsed-tramp-file-name newname nil - (let (user host localname) - (with-parsed-tramp-file-name newname l - (setq user l-user host l-host localname l-localname)) + (with-parsed-tramp-file-name newname nil (save-excursion (let ((share (tramp-smb-get-share localname)) (file (tramp-smb-get-localname localname t))) @@ -257,59 +250,46 @@ KEEP-DATE is not handled in case NEWNAME resides on an SMB server." (defun tramp-smb-handle-delete-directory (directory) "Like `delete-directory' for tramp files." (setq directory (directory-file-name (expand-file-name directory))) - (unless (file-exists-p directory) - (error "Cannot delete non-existing directory `%s'" directory)) -; (with-parsed-tramp-file-name directory nil - (let (user host localname) - (with-parsed-tramp-file-name directory l - (setq user l-user host l-host localname l-localname)) - (save-excursion - (let ((share (tramp-smb-get-share localname)) - (dir (tramp-smb-get-localname (file-name-directory localname) t)) - (file (file-name-nondirectory localname))) - (tramp-smb-maybe-open-connection user host share) - (if (and - (tramp-smb-send-command user host (format "cd \"%s\"" dir)) - (tramp-smb-send-command user host (format "rmdir \"%s\"" file))) - ;; Go Home + (when (file-exists-p directory) + (with-parsed-tramp-file-name directory nil + (save-excursion + (let ((share (tramp-smb-get-share localname)) + (dir (tramp-smb-get-localname (file-name-directory localname) t)) + (file (file-name-nondirectory localname))) + (tramp-smb-maybe-open-connection user host share) + (if (and + (tramp-smb-send-command user host (format "cd \"%s\"" dir)) + (tramp-smb-send-command user host (format "rmdir \"%s\"" file))) + ;; Go Home + (tramp-smb-send-command user host (format "cd \\")) + ;; Error (tramp-smb-send-command user host (format "cd \\")) - ;; Error - (tramp-smb-send-command user host (format "cd \\")) - (error "Cannot delete directory `%s'" directory)))))) + (error "Cannot delete directory `%s'" directory))))))) (defun tramp-smb-handle-delete-file (filename) "Like `delete-file' for tramp files." (setq filename (expand-file-name filename)) - (unless (file-exists-p filename) - (error "Cannot delete non-existing file `%s'" filename)) -; (with-parsed-tramp-file-name filename nil - (let (user host localname) - (with-parsed-tramp-file-name filename l - (setq user l-user host l-host localname l-localname)) - (save-excursion - (let ((share (tramp-smb-get-share localname)) - (dir (tramp-smb-get-localname (file-name-directory localname) t)) - (file (file-name-nondirectory localname))) - (unless (file-exists-p filename) - (error "Cannot delete non-existing file `%s'" filename)) - (tramp-smb-maybe-open-connection user host share) - (if (and - (tramp-smb-send-command user host (format "cd \"%s\"" dir)) - (tramp-smb-send-command user host (format "rm \"%s\"" file))) - ;; Go Home + (when (file-exists-p filename) + (with-parsed-tramp-file-name filename nil + (save-excursion + (let ((share (tramp-smb-get-share localname)) + (dir (tramp-smb-get-localname (file-name-directory localname) t)) + (file (file-name-nondirectory localname))) + (tramp-smb-maybe-open-connection user host share) + (if (and + (tramp-smb-send-command user host (format "cd \"%s\"" dir)) + (tramp-smb-send-command user host (format "rm \"%s\"" file))) + ;; Go Home + (tramp-smb-send-command user host (format "cd \\")) + ;; Error (tramp-smb-send-command user host (format "cd \\")) - ;; Error - (tramp-smb-send-command user host (format "cd \\")) - (error "Cannot delete file `%s'" filename)))))) + (error "Cannot delete file `%s'" filename))))))) (defun tramp-smb-handle-directory-files (directory &optional full match nosort) "Like `directory-files' for tramp files." (setq directory (directory-file-name (expand-file-name directory))) -; (with-parsed-tramp-file-name directory nil - (let (user host localname) - (with-parsed-tramp-file-name directory l - (setq user l-user host l-host localname l-localname)) + (with-parsed-tramp-file-name directory nil (save-excursion (let* ((share (tramp-smb-get-share localname)) (file (tramp-smb-get-localname localname nil)) @@ -339,17 +319,14 @@ KEEP-DATE is not handled in case NEWNAME resides on an SMB server." (mapcar (lambda (x) ;; We cannot call `file-attributes' for backward compatibility reasons. - ;; Its optional parameter ID-FORMAT is introduced with Emacs 21.4. + ;; Its optional parameter ID-FORMAT is introduced with Emacs 22. (cons x (tramp-smb-handle-file-attributes (if full x (concat (file-name-as-directory directory) x)) id-format))) (directory-files directory full match nosort))) - + (defun tramp-smb-handle-file-attributes (filename &optional id-format) "Like `file-attributes' for tramp files." -; (with-parsed-tramp-file-name filename nil - (let (user host localname) - (with-parsed-tramp-file-name filename l - (setq user l-user host l-host localname l-localname)) + (with-parsed-tramp-file-name filename nil (save-excursion (let* ((share (tramp-smb-get-share localname)) (file (tramp-smb-get-localname localname nil)) @@ -379,10 +356,7 @@ KEEP-DATE is not handled in case NEWNAME resides on an SMB server." (defun tramp-smb-handle-file-directory-p (filename) "Like `file-directory-p' for tramp files." -; (with-parsed-tramp-file-name filename nil - (let (user host localname) - (with-parsed-tramp-file-name filename l - (setq user l-user host l-host localname l-localname)) + (with-parsed-tramp-file-name filename nil (save-excursion (let* ((share (tramp-smb-get-share localname)) (file (tramp-smb-get-localname localname nil)) @@ -395,10 +369,7 @@ KEEP-DATE is not handled in case NEWNAME resides on an SMB server." (defun tramp-smb-handle-file-exists-p (filename) "Like `file-exists-p' for tramp files." -; (with-parsed-tramp-file-name filename nil - (let (user host localname) - (with-parsed-tramp-file-name filename l - (setq user l-user host l-host localname l-localname)) + (with-parsed-tramp-file-name filename nil (save-excursion (let* ((share (tramp-smb-get-share localname)) (file (tramp-smb-get-localname localname nil)) @@ -432,10 +403,7 @@ KEEP-DATE is not handled in case NEWNAME resides on an SMB server." ;; files. (defun tramp-smb-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for tramp files." -; (with-parsed-tramp-file-name directory nil - (let (user host localname) - (with-parsed-tramp-file-name directory l - (setq user l-user host l-host localname l-localname)) + (with-parsed-tramp-file-name directory nil (save-match-data (save-excursion (let* ((share (tramp-smb-get-share localname)) @@ -466,10 +434,7 @@ KEEP-DATE is not handled in case NEWNAME resides on an SMB server." (let ((dir (file-name-directory filename))) (and (file-exists-p dir) (file-writable-p dir))) -; (with-parsed-tramp-file-name filename nil - (let (user host localname) - (with-parsed-tramp-file-name filename l - (setq user l-user host l-host localname l-localname)) + (with-parsed-tramp-file-name filename nil (save-excursion (let* ((share (tramp-smb-get-share localname)) (file (tramp-smb-get-localname localname nil)) @@ -489,17 +454,14 @@ WILDCARD and FULL-DIRECTORY-P are not handled." ;; This check is a little bit strange, but in `dired-add-entry' ;; this function is called with a non-directory ... (setq filename (file-name-as-directory filename))) -; (with-parsed-tramp-file-name filename nil - (let (user host localname) - (with-parsed-tramp-file-name filename l - (setq user l-user host l-host localname l-localname)) + (with-parsed-tramp-file-name filename nil (save-match-data (let* ((share (tramp-smb-get-share localname)) (file (tramp-smb-get-localname localname nil)) (entries (tramp-smb-get-file-entries user host share file))) ;; Delete dummy "" entry, useless entries - (setq entries + (setq entries (if (file-directory-p filename) (delq (assoc "" entries) entries) ;; We just need the only and only entry FILENAME. @@ -542,10 +504,7 @@ WILDCARD and FULL-DIRECTORY-P are not handled." (setq dir (directory-file-name (expand-file-name dir))) (unless (file-name-absolute-p dir) (setq dir (concat default-directory dir))) -; (with-parsed-tramp-file-name dir nil - (let (user host localname) - (with-parsed-tramp-file-name dir l - (setq user l-user host l-host localname l-localname)) + (with-parsed-tramp-file-name dir nil (save-match-data (let* ((share (tramp-smb-get-share localname)) (ldir (file-name-directory dir))) @@ -563,10 +522,7 @@ WILDCARD and FULL-DIRECTORY-P are not handled." (setq directory (directory-file-name (expand-file-name directory))) (unless (file-name-absolute-p directory) (setq directory (concat default-directory directory))) -; (with-parsed-tramp-file-name directory nil - (let (user host localname) - (with-parsed-tramp-file-name directory l - (setq user l-user host l-host localname l-localname)) + (with-parsed-tramp-file-name directory nil (save-match-data (let* ((share (tramp-smb-get-share localname)) (file (tramp-smb-get-localname localname nil))) @@ -596,10 +552,7 @@ WILDCARD and FULL-DIRECTORY-P are not handled." (file-exists-p newname)) (error "rename-file: file %s already exists" newname)) -; (with-parsed-tramp-file-name newname nil - (let (user host localname) - (with-parsed-tramp-file-name newname l - (setq user l-user host l-host localname l-localname)) + (with-parsed-tramp-file-name newname nil (save-excursion (let ((share (tramp-smb-get-share localname)) (file (tramp-smb-get-localname localname t))) @@ -616,6 +569,13 @@ WILDCARD and FULL-DIRECTORY-P are not handled." (delete-file filename)) +(defun tramp-smb-handle-substitute-in-file-name (filename) + "Like `handle-substitute-in-file-name' for tramp files. +Catches errors for shares like \"C$/\", which are common in Microsoft Windows." + (condition-case nil + (tramp-run-real-handler 'substitute-in-file-name (list filename)) + (error filename))) + (defun tramp-smb-handle-write-region (start end filename &optional append visit lockname confirm) "Like `write-region' for tramp files." @@ -628,21 +588,11 @@ WILDCARD and FULL-DIRECTORY-P are not handled." (unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename)) (error "File not overwritten"))) -; (with-parsed-tramp-file-name filename nil - (let (user host localname) - (with-parsed-tramp-file-name filename l - (setq user l-user host l-host localname l-localname)) + (with-parsed-tramp-file-name filename nil (save-excursion (let ((share (tramp-smb-get-share localname)) (file (tramp-smb-get-localname localname t)) (curbuf (current-buffer)) - ;; We use this to save the value of `last-coding-system-used' - ;; after writing the tmp file. At the end of the function, - ;; we set `last-coding-system-used' to this saved value. - ;; This way, any intermediary coding systems used while - ;; talking to the remote shell or suchlike won't hose this - ;; variable. This approach was snarfed from ange-ftp.el. - coding-system-used tmpfil) ;; Write region into a tmp file. (setq tmpfil (tramp-make-temp-file)) @@ -654,9 +604,6 @@ WILDCARD and FULL-DIRECTORY-P are not handled." (if confirm ; don't pass this arg unless defined for backward compat. (list start end tmpfil append 'no-message lockname confirm) (list start end tmpfil append 'no-message lockname))) - ;; Now, `last-coding-system-used' has the right value. Remember it. - (when (boundp 'last-coding-system-used) - (setq coding-system-used last-coding-system-used)) (tramp-smb-maybe-open-connection user host share) (tramp-message-for-buffer @@ -674,10 +621,7 @@ WILDCARD and FULL-DIRECTORY-P are not handled." (error "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) (when (eq visit t) - (set-visited-file-modtime)) - ;; Make `last-coding-system-used' have the right value. - (when (boundp 'last-coding-system-used) - (setq last-coding-system-used coding-system-used)))))) + (set-visited-file-modtime)))))) ;; Internal file name functions @@ -961,6 +905,10 @@ then sends the password to the remote host. Domain names in USER and port numbers in HOST are acknowledged." + (when (and (fboundp 'executable-find) + (not (funcall 'executable-find tramp-smb-program))) + (error "Cannot find command %s in %s" tramp-smb-program exec-path)) + (save-match-data (let* ((buffer (tramp-get-buffer nil tramp-smb-method user host)) (real-user user) @@ -988,7 +936,7 @@ Domain names in USER and port numbers in HOST are acknowledged." (when port (setq args (append args (list "-p" port)))) ; OK, let's go - (tramp-pre-connection nil tramp-smb-method user host) + (tramp-pre-connection nil tramp-smb-method user host tramp-chunksize) (tramp-message 7 "Opening connection for //%s@%s/%s..." user host (or share "")) @@ -1003,7 +951,7 @@ Domain names in USER and port numbers in HOST are acknowledged." tramp-smb-program args))) (tramp-message 9 "Started process %s" (process-command p)) - (process-kill-without-query p) + (tramp-set-process-query-on-exit-flag p nil) (set-buffer buffer) (setq tramp-smb-share share) @@ -1011,7 +959,7 @@ Domain names in USER and port numbers in HOST are acknowledged." (when real-user (let ((pw-prompt "Password:")) (tramp-message 9 "Sending password") - (tramp-enter-password p pw-prompt))) + (tramp-enter-password p pw-prompt user host))) (unless (tramp-smb-wait-for-output user host) (tramp-clear-passwd user host) @@ -1031,10 +979,10 @@ Returns nil if an error message has appeared." ;; Algorithm: get waiting output. See if last line contains ;; tramp-smb-prompt sentinel or tramp-smb-errors strings. ;; If not, wait a bit and again get waiting output. - (while (and (not found) (not err)) + (while (not found) ;; Accept pending output. - (accept-process-output proc) + (tramp-accept-process-output proc) ;; Search for prompt. (goto-char (point-min)) @@ -1083,45 +1031,6 @@ Return the difference in the format of a time value." (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2))))) -;; `PC-do-completion' touches the returning "$$" by `substitute-in-file-name'. -;; Must be corrected. - -(defadvice PC-do-completion (around tramp-smb-advice-PC-do-completion activate) - "Changes \"$\" back to \"$$\" in minibuffer." - (if (funcall PC-completion-as-file-name-predicate) - - (progn - ;; Substitute file names - (let* ((beg (or (and (functionp 'minibuffer-prompt-end) ; Emacs 21 - (funcall 'minibuffer-prompt-end)) - (point-min))) - (end (point-max)) - (str (substitute-in-file-name (buffer-substring beg end)))) - (delete-region beg end) - (insert str) - (ad-set-arg 2 (point))) - - ;; Do `PC-do-completion' without substitution - (let* (save) - (fset 'save (symbol-function 'substitute-in-file-name)) - (fset 'substitute-in-file-name (symbol-function 'identity)) - ad-do-it - (fset 'substitute-in-file-name (symbol-function 'save))) - - ;; Expand "$" - (let* ((beg (or (and (functionp 'minibuffer-prompt-end) ; Emacs 21 - (funcall 'minibuffer-prompt-end)) - (point-min))) - (end (point-max)) - (str (buffer-substring beg end))) - (delete-region beg end) - (insert (if (string-match "\\(\\$\\)\\(/\\|$\\)" str) - (replace-match "$$" nil nil str 1) - str)))) - - ;; No file names. Behave unchanged. - ad-do-it)) - (provide 'tramp-smb) ;;; TODO: