;;; 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 <michael.albinus@gmx.de>
;; Keywords: comm, processes
+;; Package: tramp
;; This file is part of GNU Emacs.
(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.
: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.")
(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)
(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)
(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)
(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)
"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
(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.
(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)
'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)))))
(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
(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)
;; 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 "/".
(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
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
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
(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)
(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))
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)))))
(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.
"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."
(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)))))
(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
(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.
;; 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
(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)
(tramp-message vec 6 "\n%s" (buffer-string))
(not err))))
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-smb 'force)))
(provide 'tramp-smb)
HCoop / bpt / emacs.git / blobdiff