;;; tramp-smb.el --- Tramp access functions for SMB servers
-;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2016 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;;; Code:
-(eval-when-compile (require 'cl)) ; block, return
(require 'tramp)
+;; Pacify byte-compiler.
+(eval-when-compile
+ (require 'cl))
+
;; Define SMB method ...
;;;###tramp-autoload
(defconst tramp-smb-method "smb"
- "*Method to connect SAMBA and M$ SMB servers.")
+ "Method to connect SAMBA and M$ SMB servers.")
;; ... and add it to the method list.
;;;###tramp-autoload
;; We define an empty command, because `tramp-smb-call-winexe'
;; opens already the powershell. Used in `tramp-handle-shell-command'.
(tramp-remote-shell "")
- ;; This is just a guess. We don't know whether the share "$C"
+ ;; This is just a guess. We don't know whether the share "C$"
;; is available for public use, and whether the user has write
;; access.
(tramp-tmpdir "/C$/Temp"))))
tramp-smb-method
'((tramp-parse-netrc "~/.netrc"))))
+;;;###tramp-autoload
(defcustom tramp-smb-program "smbclient"
- "*Name of SMB client to run."
+ "Name of SMB client to run."
:group 'tramp
:type 'string)
+;;;###tramp-autoload
+(defcustom tramp-smb-acl-program "smbcacls"
+ "Name of SMB acls to run."
+ :group 'tramp
+ :type 'string
+ :version "24.4")
+
+;;;###tramp-autoload
(defcustom tramp-smb-conf "/dev/null"
- "*Path of the smb.conf file.
+ "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.")
+ "Version string of the SMB client.")
+
+(defconst tramp-smb-server-version
+ "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]"
+ "Regexp of SMB server identification.")
-(defconst tramp-smb-prompt "^smb: .+> \\|^\\s-+Server\\s-+Comment$"
- "Regexp used as prompt in smbclient.")
+(defconst tramp-smb-prompt "^\\(smb:\\|PS\\) .+> \\|^\\s-+Server\\s-+Comment$"
+ "Regexp used as prompt in smbclient or powershell.")
+
+(defconst tramp-smb-wrong-passwd-regexp
+ (regexp-opt
+ '("NT_STATUS_LOGON_FAILURE"
+ "NT_STATUS_WRONG_PASSWORD"))
+ "Regexp for login error strings of SMB servers.")
(defconst tramp-smb-errors
(mapconcat
"NT_STATUS_DIRECTORY_NOT_EMPTY"
"NT_STATUS_DUPLICATE_NAME"
"NT_STATUS_FILE_IS_A_DIRECTORY"
+ "NT_STATUS_HOST_UNREACHABLE"
"NT_STATUS_IMAGE_ALREADY_LOADED"
+ "NT_STATUS_INVALID_LEVEL"
"NT_STATUS_IO_TIMEOUT"
"NT_STATUS_LOGON_FAILURE"
"NT_STATUS_NETWORK_ACCESS_DENIED"
"NT_STATUS_NOT_IMPLEMENTED"
+ "NT_STATUS_NO_LOGON_SERVERS"
"NT_STATUS_NO_SUCH_FILE"
"NT_STATUS_NO_SUCH_USER"
"NT_STATUS_OBJECT_NAME_COLLISION"
See `tramp-actions-before-shell' for more info.")
+(defconst tramp-smb-actions-with-tar
+ '((tramp-password-prompt-regexp tramp-action-password)
+ (tramp-wrong-passwd-regexp tramp-action-permission-denied)
+ (tramp-smb-errors tramp-action-permission-denied)
+ (tramp-process-alive-regexp tramp-smb-action-with-tar))
+ "List of pattern/action pairs.
+This list is used for tar-like copy of directories.
+
+See `tramp-actions-before-shell' for more info.")
+
+(defconst tramp-smb-actions-get-acl
+ '((tramp-password-prompt-regexp tramp-action-password)
+ (tramp-wrong-passwd-regexp tramp-action-permission-denied)
+ (tramp-smb-errors tramp-action-permission-denied)
+ (tramp-process-alive-regexp tramp-smb-action-get-acl))
+ "List of pattern/action pairs.
+This list is used for smbcacls actions.
+
+See `tramp-actions-before-shell' for more info.")
+
+(defconst tramp-smb-actions-set-acl
+ '((tramp-password-prompt-regexp tramp-action-password)
+ (tramp-wrong-passwd-regexp tramp-action-permission-denied)
+ (tramp-smb-errors tramp-action-permission-denied)
+ (tramp-process-alive-regexp tramp-smb-action-set-acl))
+ "List of pattern/action pairs.
+This list is used for smbcacls actions.
+
+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-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
(copy-directory . tramp-smb-handle-copy-directory)
(directory-files . tramp-smb-handle-directory-files)
(directory-files-and-attributes
. tramp-handle-directory-files-and-attributes)
- (dired-call-process . ignore)
(dired-compress-file . ignore)
(dired-uncache . tramp-handle-dired-uncache)
(expand-file-name . tramp-smb-handle-expand-file-name)
(file-accessible-directory-p . tramp-smb-handle-file-directory-p)
+ (file-acl . tramp-smb-handle-file-acl)
(file-attributes . tramp-smb-handle-file-attributes)
(file-directory-p . tramp-smb-handle-file-directory-p)
+ (file-file-equal-p . tramp-handle-file-equal-p)
(file-executable-p . tramp-handle-file-exists-p)
(file-exists-p . tramp-handle-file-exists-p)
+ (file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-smb-handle-file-local-copy)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-smb-handle-file-name-all-completions)
(file-name-nondirectory . tramp-handle-file-name-nondirectory)
;; `file-name-sans-versions' performed by default handler.
(file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
+ (file-notify-add-watch . tramp-handle-file-notify-add-watch)
+ (file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
+ (file-notify-valid-p . tramp-handle-file-notify-valid-p)
(file-ownership-preserved-p . ignore)
(file-readable-p . tramp-handle-file-exists-p)
(file-regular-p . tramp-handle-file-regular-p)
(insert-directory . tramp-smb-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load)
+ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-smb-handle-make-directory)
(make-directory-internal . tramp-smb-handle-make-directory-internal)
(make-symbolic-link . tramp-smb-handle-make-symbolic-link)
+ (process-file . tramp-smb-handle-process-file)
(rename-file . tramp-smb-handle-rename-file)
+ (set-file-acl . tramp-smb-handle-set-file-acl)
(set-file-modes . tramp-smb-handle-set-file-modes)
- ;; `set-file-selinux-context' performed by default handler.
+ (set-file-selinux-context . ignore)
(set-file-times . ignore)
- (set-visited-file-modtime . ignore)
- (shell-command . ignore)
+ (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
+ (shell-command . tramp-handle-shell-command)
+ (start-file-process . tramp-smb-handle-start-file-process)
(substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
- (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
+ (unhandled-file-name-directory . ignore)
(vc-registered . ignore)
- (verify-visited-file-modtime . ignore)
- (write-region . tramp-smb-handle-write-region)
-)
+ (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
+ (write-region . tramp-smb-handle-write-region))
"Alist of handler functions for Tramp SMB method.
Operations not mentioned here will be handled by the default Emacs primitives.")
+;; Options for remote processes via winexe.
+;;;###tramp-autoload
+(defcustom tramp-smb-winexe-program "winexe"
+ "Name of winexe client to run.
+If it isn't found in the local $PATH, the absolute path of winexe
+shall be given. This is needed for remote processes."
+ :group 'tramp
+ :type 'string
+ :version "24.3")
+
+;;;###tramp-autoload
+(defcustom tramp-smb-winexe-shell-command "powershell.exe"
+ "Shell to be used for processes on remote machines.
+This must be Powershell V2 compatible."
+ :group 'tramp
+ :type 'string
+ :version "24.3")
+
+;;;###tramp-autoload
+(defcustom tramp-smb-winexe-shell-command-switch "-file -"
+ "Command switch used together with `tramp-smb-winexe-shell-command'.
+This can be used to disable echo etc."
+ :group 'tramp
+ :type 'string
+ :version "24.3")
+
+;; It must be a `defsubst' in order to push the whole code into
+;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
;;;###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)))
+ (string= (tramp-file-name-method (tramp-dissect-file-name filename))
+ tramp-smb-method))
;;;###tramp-autoload
(defun tramp-smb-file-name-handler (operation &rest args)
"error with add-name-to-file, see buffer `%s' for details"
(buffer-name))))))
+(defun tramp-smb-action-with-tar (proc vec)
+ "Untar from connection buffer."
+ (if (not (memq (process-status proc) '(run open)))
+ (throw 'tramp-action 'process-died)
+
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (goto-char (point-min))
+ (when (search-forward-regexp tramp-smb-server-version nil t)
+ ;; There might be a hidden password prompt.
+ (widen)
+ (forward-line)
+ (tramp-message vec 6 (buffer-substring (point-min) (point)))
+ (delete-region (point-min) (point))
+ (throw 'tramp-action 'ok)))))
+
(defun tramp-smb-handle-copy-directory
- (dirname newname &optional keep-date parents)
- "Like `copy-directory' for Tramp files. KEEP-DATE is not handled."
- (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
- (cond
- ;; We must use a local temporary directory.
- ((and t1 t2)
- (let ((tmpdir
- (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix
- (tramp-compat-temporary-file-directory)))))
- (unwind-protect
- (progn
- (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)
- (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 v)))
- (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))))
- ;; Go home.
- (tramp-smb-send-command
- v (format
- "cd %s" (if (tramp-smb-get-cifs-capabilities v) "/" "\\")))
- ;; 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.
- (t
- (tramp-run-real-handler
- 'copy-directory (list dirname newname keep-date parents)))))))
+ (dirname newname &optional keep-date parents copy-contents)
+ "Like `copy-directory' for Tramp files."
+ (if copy-contents
+ ;; We must do it file-wise.
+ (tramp-run-real-handler
+ 'copy-directory (list dirname newname keep-date parents copy-contents))
+
+ (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
+ (with-tramp-progress-reporter
+ v 0 (format "Copying %s to %s" dirname newname)
+ (cond
+ ;; We must use a local temporary directory.
+ ((and t1 t2)
+ (let ((tmpdir
+ (make-temp-name
+ (expand-file-name
+ tramp-temp-name-prefix
+ (tramp-compat-temporary-file-directory)))))
+ (unwind-protect
+ (progn
+ (make-directory tmpdir)
+ (copy-directory dirname tmpdir keep-date 'parents)
+ (copy-directory
+ (expand-file-name (file-name-nondirectory dirname) tmpdir)
+ newname keep-date parents))
+ (delete-directory tmpdir 'recursive))))
+
+ ;; We can copy recursively.
+ ((or t1 t2)
+ (when (and (file-directory-p newname)
+ (not (string-equal (file-name-nondirectory dirname)
+ (file-name-nondirectory newname))))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory dirname) newname))
+ (if t2 (setq v (tramp-dissect-file-name newname))))
+ (if (not (file-directory-p newname))
+ (make-directory newname parents))
+
+ (setq tramp-current-method (tramp-file-name-method v)
+ tramp-current-user (tramp-file-name-user v)
+ tramp-current-host (tramp-file-name-real-host v))
+
+ (let* ((real-user (tramp-file-name-real-user v))
+ (real-host (tramp-file-name-real-host v))
+ (domain (tramp-file-name-domain v))
+ (port (tramp-file-name-port v))
+ (share (tramp-smb-get-share v))
+ (localname (file-name-as-directory
+ (replace-regexp-in-string
+ "\\\\" "/" (tramp-smb-get-localname v))))
+ (tmpdir (make-temp-name
+ (expand-file-name
+ tramp-temp-name-prefix
+ (tramp-compat-temporary-file-directory))))
+ (args (list (concat "//" real-host "/" share) "-E")))
+
+ (if (not (zerop (length real-user)))
+ (setq args (append args (list "-U" real-user)))
+ (setq args (append args (list "-N"))))
+
+ (when domain (setq args (append args (list "-W" domain))))
+ (when port (setq args (append args (list "-p" port))))
+ (when tramp-smb-conf
+ (setq args (append args (list "-s" tramp-smb-conf))))
+ (setq args
+ (if t1
+ ;; Source is remote.
+ (append args
+ (list "-D" (shell-quote-argument localname)
+ "-c" (shell-quote-argument "tar qc - *")
+ "|" "tar" "xfC" "-"
+ (shell-quote-argument tmpdir)))
+ ;; Target is remote.
+ (append (list "tar" "cfC" "-"
+ (shell-quote-argument dirname) "." "|")
+ args
+ (list "-D" (shell-quote-argument localname)
+ "-c" (shell-quote-argument "tar qx -")))))
+
+ (unwind-protect
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ (when t1
+ ;; The smbclient tar command creates always
+ ;; complete paths. We must emulate the
+ ;; directory structure, and symlink to the real
+ ;; target.
+ (make-directory
+ (expand-file-name
+ ".." (concat tmpdir localname)) 'parents)
+ (make-symbolic-link
+ newname (directory-file-name (concat tmpdir localname))))
+
+ ;; Use an asynchronous processes. By this,
+ ;; password can be handled.
+ (let* ((default-directory tmpdir)
+ (p (apply
+ 'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-program args)))
+
+ (tramp-message
+ v 6 "%s" (mapconcat 'identity (process-command p) " "))
+ (tramp-set-connection-property p "vector" v)
+ (set-process-query-on-exit-flag p nil)
+ (tramp-process-actions p v nil tramp-smb-actions-with-tar)
+
+ (while (memq (process-status p) '(run open))
+ (sit-for 0.1))
+ (tramp-message v 6 "\n%s" (buffer-string))))
+
+ ;; Reset the transfer process properties.
+ (tramp-set-connection-property v "process-name" nil)
+ (tramp-set-connection-property v "process-buffer" nil)
+ (when t1 (delete-directory tmpdir 'recurse))))
+
+ ;; Handle KEEP-DATE argument.
+ (when keep-date
+ (set-file-times newname (nth 5 (file-attributes dirname))))
+
+ ;; Set the mode.
+ (unless keep-date
+ (set-file-modes newname (tramp-default-file-modes dirname)))
+
+ ;; When newname did exist, we have wrong cached values.
+ (when t2
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-file-property v localname))))
+
+ ;; We must do it file-wise.
+ (t
+ (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 preserve-selinux-context)
+ _preserve-uid-gid _preserve-extended-attributes)
"Like `copy-file' for Tramp files.
-KEEP-DATE is not handled in case NEWNAME resides on an SMB server.
-PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored."
+KEEP-DATE has no effect in case NEWNAME resides on an SMB server.
+PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setq filename (expand-file-name filename)
newname (expand-file-name newname))
- (tramp-with-progress-reporter
- (tramp-dissect-file-name (if (file-remote-p filename) filename newname))
+ (with-tramp-progress-reporter
+ (tramp-dissect-file-name
+ (if (tramp-tramp-file-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))
-
- ;; 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))))))
+ (if (file-directory-p filename)
+ (tramp-compat-copy-directory
+ filename newname keep-date 'parents 'copy-contents)
+
+ (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))
+ (unless (tramp-smb-send-command
+ v (format "put \"%s\" \"%s\""
+ filename (tramp-smb-get-localname v)))
+ (tramp-error
+ v 'file-error "Cannot copy `%s' to `%s'" filename newname))))))
- ;; KEEP-DATE handling.
- (when keep-date (set-file-times newname (nth 5 (file-attributes 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."
(mapc
(lambda (file)
(if (file-directory-p file)
- (tramp-compat-delete-directory file recursive)
+ (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 &optional trash)
+(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)
(when full
(setq result
(mapcar
- (lambda (x) (expand-file-name x directory))
+ (lambda (x) (format "%s/%s" directory x))
result)))
;; Sort them if necessary.
(unless nosort (setq result (sort result 'string-lessp)))
- ;; That's it.
- result))
+ ;; Remove double entries.
+ (delete-dups result)))
(defun tramp-smb-handle-expand-file-name (name &optional dir)
"Like `expand-file-name' for Tramp files."
method user host
(tramp-run-real-handler 'expand-file-name (list localname))))))
+(defun tramp-smb-action-get-acl (proc vec)
+ "Read ACL data from connection buffer."
+ (when (not (memq (process-status proc) '(run open)))
+ ;; Accept pending output.
+ (while (tramp-accept-process-output proc 0.1))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ ;; There might be a hidden password prompt.
+ (widen)
+ (tramp-message vec 10 "\n%s" (buffer-string))
+ (goto-char (point-min))
+ (while (and (not (eobp)) (not (looking-at "^REVISION:")))
+ (forward-line)
+ (delete-region (point-min) (point)))
+ (while (and (not (eobp)) (looking-at "^.+:.+"))
+ (forward-line))
+ (delete-region (point) (point-max))
+ (throw 'tramp-action 'ok))))
+
+(defun tramp-smb-handle-file-acl (filename)
+ "Like `file-acl' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-acl"
+ (when (executable-find tramp-smb-acl-program)
+
+ (setq tramp-current-method (tramp-file-name-method v)
+ tramp-current-user (tramp-file-name-user v)
+ tramp-current-host (tramp-file-name-real-host v))
+
+ (let* ((real-user (tramp-file-name-real-user v))
+ (real-host (tramp-file-name-real-host v))
+ (domain (tramp-file-name-domain v))
+ (port (tramp-file-name-port v))
+ (share (tramp-smb-get-share v))
+ (localname (replace-regexp-in-string
+ "\\\\" "/" (tramp-smb-get-localname v)))
+ (args (list (concat "//" real-host "/" share) "-E")))
+
+ (if (not (zerop (length real-user)))
+ (setq args (append args (list "-U" real-user)))
+ (setq args (append args (list "-N"))))
+
+ (when domain (setq args (append args (list "-W" domain))))
+ (when port (setq args (append args (list "-p" port))))
+ (when tramp-smb-conf
+ (setq args (append args (list "-s" tramp-smb-conf))))
+ (setq
+ args
+ (append args (list (shell-quote-argument localname) "2>/dev/null")))
+
+ (unwind-protect
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ ;; Use an asynchronous processes. By this, password
+ ;; can be handled.
+ (let ((p (apply
+ 'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-acl-program args)))
+
+ (tramp-message
+ v 6 "%s" (mapconcat 'identity (process-command p) " "))
+ (tramp-set-connection-property p "vector" v)
+ (set-process-query-on-exit-flag p nil)
+ (tramp-process-actions p v nil tramp-smb-actions-get-acl)
+ (when (> (point-max) (point-min))
+ (substring-no-properties (buffer-string)))))
+
+ ;; Reset the transfer process properties.
+ (tramp-set-connection-property v "process-name" nil)
+ (tramp-set-connection-property v "process-buffer" nil)))))))
+
(defun tramp-smb-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
(unless id-format (setq id-format 'integer))
(ignore-errors
(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-stat-capability v))
+ (with-tramp-file-property
+ v localname (format "file-attributes-%s" id-format)
+ (if (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
"Implement `file-attributes' for Tramp files using stat command."
(tramp-message
vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec))
- (with-current-buffer (tramp-get-buffer vec)
+ (with-current-buffer (tramp-get-connection-buffer vec)
(let* (size id link uid gid atime mtime ctime mode inode)
(when (tramp-smb-send-command
vec (format "stat \"%s\"" (tramp-smb-get-localname vec)))
v 'file-error
"Cannot make local copy of non-existing file `%s'" filename))
(let ((tmpfile (tramp-compat-make-temp-file filename)))
- (tramp-with-progress-reporter
+ (with-tramp-progress-reporter
v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
(unless (tramp-smb-send-command
v (format "get \"%s\" \"%s\""
(all-completions
filename
(with-parsed-tramp-file-name directory nil
- (with-file-property v localname "file-name-all-completions"
+ (with-tramp-file-property v localname "file-name-all-completions"
(save-match-data
(let ((entries (tramp-smb-get-file-entries directory)))
(mapcar
(filename switches &optional wildcard full-directory-p)
"Like `insert-directory' for Tramp files."
(setq filename (expand-file-name filename))
+ (unless switches (setq switches ""))
+ ;; Mark trailing "/".
+ (when (and (zerop (length (file-name-nondirectory filename)))
+ (not full-directory-p))
+ (setq switches (concat switches "F")))
(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))
- ;; We should not destroy the cache entry.
- (entries (copy-sequence
- (tramp-smb-get-file-entries
- (file-name-directory filename)))))
-
- (when wildcard
- (string-match "\\." base)
- (setq base (replace-match "\\\\." nil nil base))
- (string-match "\\*" base)
- (setq base (replace-match ".*" nil nil base))
- (string-match "\\?" base)
- (setq base (replace-match ".?" nil nil base)))
-
- ;; Filter entries.
- (setq entries
- (delq
- nil
- (if (or wildcard (zerop (length base)))
- ;; Check for matching entries.
- (mapcar
- (lambda (x)
- (when (string-match
- (format "^%s" base) (nth 0 x))
- x))
- entries)
- ;; We just need the only and only entry FILENAME.
- (list (assoc base entries)))))
-
- ;; Sort entries.
- (setq entries
- (sort
- entries
- (lambda (x y)
- (if (string-match "t" switches)
- ;; Sort by date.
- (tramp-time-less-p (nth 3 y) (nth 3 x))
- ;; Sort by name.
- (string-lessp (nth 0 x) (nth 0 y))))))
-
- ;; Handle "-F" switch.
- (when (string-match "F" switches)
+ (with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
+ (save-match-data
+ (let ((base (file-name-nondirectory filename))
+ ;; We should not destroy the cache entry.
+ (entries (copy-sequence
+ (tramp-smb-get-file-entries
+ (file-name-directory filename)))))
+
+ (when wildcard
+ (string-match "\\." base)
+ (setq base (replace-match "\\\\." nil nil base))
+ (string-match "\\*" base)
+ (setq base (replace-match ".*" nil nil base))
+ (string-match "\\?" base)
+ (setq base (replace-match ".?" nil nil base)))
+
+ ;; Filter entries.
+ (setq entries
+ (delq
+ nil
+ (if (or wildcard (zerop (length base)))
+ ;; Check for matching entries.
+ (mapcar
+ (lambda (x)
+ (when (string-match
+ (format "^%s" base) (nth 0 x))
+ x))
+ entries)
+ ;; We just need the only and only entry FILENAME.
+ (list (assoc base entries)))))
+
+ ;; Sort entries.
+ (setq entries
+ (sort
+ entries
+ (lambda (x y)
+ (if (string-match "t" switches)
+ ;; Sort by date.
+ (time-less-p (nth 3 y) (nth 3 x))
+ ;; Sort by name.
+ (string-lessp (nth 0 x) (nth 0 y))))))
+
+ ;; Handle "-F" switch.
+ (when (string-match "F" switches)
+ (mapc
+ (lambda (x)
+ (when (not (zerop (length (car x))))
+ (cond
+ ((char-equal ?d (string-to-char (nth 1 x)))
+ (setcar x (concat (car x) "/")))
+ ((char-equal ?x (string-to-char (nth 1 x)))
+ (setcar x (concat (car x) "*"))))))
+ entries))
+
+ ;; Print entries.
(mapc
(lambda (x)
- (when (not (zerop (length (car x))))
- (cond
- ((char-equal ?d (string-to-char (nth 1 x)))
- (setcar x (concat (car x) "/")))
- ((char-equal ?x (string-to-char (nth 1 x)))
- (setcar x (concat (car x) "*"))))))
- entries))
-
- ;; Print entries.
- (mapc
- (lambda (x)
- (when (not (zerop (length (nth 0 x))))
- (let ((attr
- (when (tramp-smb-get-stat-capability v)
- (ignore-errors
- (file-attributes filename 'string)))))
- (insert
- (format
- "%10s %3d %-8s %-8s %8s %s "
- (or (nth 8 attr) (nth 1 x)) ; mode
- (or (nth 1 attr) 1) ; inode
- (or (nth 2 attr) "nobody") ; uid
- (or (nth 3 attr) "nogroup") ; gid
- (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
+ (when (not (zerop (length (nth 0 x))))
+ (when (string-match "l" switches)
+ (let ((attr
+ (when (tramp-smb-get-stat-capability v)
+ (ignore-errors
+ (file-attributes filename 'string)))))
+ (insert
+ (format
+ "%10s %3d %-8s %-8s %8s %s "
+ (or (nth 8 attr) (nth 1 x)) ; mode
+ (or (nth 1 attr) 1) ; inode
+ (or (nth 2 attr) "nobody") ; uid
+ (or (nth 3 attr) "nogroup") ; gid
+ (or (nth 7 attr) (nth 2 x)) ; size
+ (format-time-string
+ (if (time-less-p (time-subtract (current-time) (nth 3 x))
+ tramp-half-a-year)
+ "%b %e %R"
+ "%b %e %Y")
+ (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'.
+ ;; 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)))))
+ (nth 0 x) (file-name-directory filename))
+ (when full-directory-p (file-name-directory filename)))))
(put-text-property start (1- (point)) 'dired-filename t))
(forward-line)
- (beginning-of-line))))
- entries)))))
+ (beginning-of-line)))
+ entries))))))
(defun tramp-smb-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
(tramp-smb-send-command
v
(if (tramp-smb-get-cifs-capabilities v)
- (format
- "posix_mkdir \"%s\" %s"
- file (tramp-compat-decimal-to-octal (default-file-modes)))
+ (format "posix_mkdir \"%s\" %o" file (default-file-modes))
(format "mkdir \"%s\"" file)))
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
"error with make-symbolic-link, see buffer `%s' for details"
(buffer-name))))))
+(defun tramp-smb-handle-process-file
+ (program &optional infile destination display &rest args)
+ "Like `process-file' for Tramp files."
+ ;; The implementation is not complete yet.
+ (when (and (numberp destination) (zerop destination))
+ (error "Implementation does not handle immediate return"))
+
+ (with-parsed-tramp-file-name default-directory nil
+ (let* ((name (file-name-nondirectory program))
+ (name1 name)
+ (i 0)
+ input tmpinput outbuf command ret)
+
+ ;; Determine input.
+ (when infile
+ (setq infile (expand-file-name infile))
+ (if (tramp-equal-remote default-directory infile)
+ ;; INFILE is on the same remote host.
+ (setq input (with-parsed-tramp-file-name infile nil localname))
+ ;; INFILE must be copied to remote host.
+ (setq input (tramp-make-tramp-temp-file v)
+ tmpinput (tramp-make-tramp-file-name method user host input))
+ (copy-file infile tmpinput t))
+ ;; Transform input into a filename powershell does understand.
+ (setq input (format "//%s%s" host input)))
+
+ ;; Determine output.
+ (cond
+ ;; Just a buffer.
+ ((bufferp destination)
+ (setq outbuf destination))
+ ;; A buffer name.
+ ((stringp destination)
+ (setq outbuf (get-buffer-create destination)))
+ ;; (REAL-DESTINATION ERROR-DESTINATION)
+ ((consp destination)
+ ;; output.
+ (cond
+ ((bufferp (car destination))
+ (setq outbuf (car destination)))
+ ((stringp (car destination))
+ (setq outbuf (get-buffer-create (car destination))))
+ ((car destination)
+ (setq outbuf (current-buffer))))
+ ;; stderr.
+ (tramp-message v 2 "%s" "STDERR not supported"))
+ ;; 't
+ (destination
+ (setq outbuf (current-buffer))))
+
+ ;; Construct command.
+ (setq command (mapconcat 'identity (cons program args) " ")
+ command (if input
+ (format
+ "get-content %s | & %s"
+ (tramp-smb-shell-quote-argument input) command)
+ (format "& %s" command)))
+
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name1)
+ (tramp-set-connection-property
+ v "process-buffer"
+ (or outbuf (generate-new-buffer tramp-temp-buffer-name)))
+
+ ;; Call it.
+ (condition-case nil
+ (with-current-buffer (tramp-get-connection-buffer v)
+ ;; Preserve buffer contents.
+ (narrow-to-region (point-max) (point-max))
+ (tramp-smb-call-winexe v)
+ (when (tramp-smb-get-share v)
+ (tramp-smb-send-command
+ v (format "cd \"//%s%s\"" host (file-name-directory localname))))
+ (tramp-smb-send-command v command)
+ ;; Preserve command output.
+ (narrow-to-region (point-max) (point-max))
+ (let ((p (tramp-get-connection-process v)))
+ (tramp-smb-send-command v "exit $lasterrorcode")
+ (while (memq (process-status p) '(run open))
+ (sleep-for 0.1)
+ (setq ret (process-exit-status p))))
+ (delete-region (point-min) (point-max))
+ (widen))
+
+ ;; When the user did interrupt, we should do it also. We use
+ ;; return code -1 as marker.
+ (quit
+ (setq ret -1))
+ ;; Handle errors.
+ (error
+ (setq ret 1)))
+
+ ;; We should redisplay the output.
+ (when (and display outbuf (get-buffer-window outbuf t)) (redisplay))
+
+ ;; Cleanup. We remove all file cache values for the connection,
+ ;; because the remote process could have changed them.
+ (tramp-set-connection-property v "process-name" nil)
+ (tramp-set-connection-property v "process-buffer" nil)
+ (when tmpinput (delete-file tmpinput))
+ (unless outbuf
+ (kill-buffer (tramp-get-connection-property v "process-buffer" nil)))
+
+ (unless process-file-side-effects
+ (tramp-flush-directory-property v ""))
+
+ ;; Return exit status.
+ (if (equal ret -1)
+ (keyboard-quit)
+ ret))))
+
(defun tramp-smb-handle-rename-file
(filename newname &optional ok-if-already-exists)
"Like `rename-file' for Tramp files."
(setq filename (expand-file-name filename)
newname (expand-file-name newname))
- (tramp-with-progress-reporter
- (tramp-dissect-file-name (if (file-remote-p filename) filename newname))
+
+ (when (and (not ok-if-already-exists)
+ (file-exists-p newname))
+ (tramp-error
+ (tramp-dissect-file-name
+ (if (tramp-tramp-file-p filename) filename newname))
+ 'file-already-exists newname))
+
+ (with-tramp-progress-reporter
+ (tramp-dissect-file-name
+ (if (tramp-tramp-file-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)))))
+ (if (and (not (file-exists-p newname))
+ (tramp-equal-remote filename newname)
+ (string-equal
+ (tramp-smb-get-share (tramp-dissect-file-name filename))
+ (tramp-smb-get-share (tramp-dissect-file-name newname))))
+ ;; We can rename directly.
+ (with-parsed-tramp-file-name filename v1
+ (with-parsed-tramp-file-name newname v2
+
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-property v1 (file-name-directory v1-localname))
+ (tramp-flush-file-property v1 v1-localname)
+ (tramp-flush-file-property v2 (file-name-directory v2-localname))
+ (tramp-flush-file-property v2 v2-localname)
+ (unless (tramp-smb-get-share v2)
+ (tramp-error
+ v2 'file-error "Target `%s' must contain a share name" newname))
+ (unless (tramp-smb-send-command
+ v2 (format "rename \"%s\" \"%s\""
+ (tramp-smb-get-localname v1)
+ (tramp-smb-get-localname v2)))
+ (tramp-error v2 'file-error "Cannot rename `%s'" filename))))
+
+ ;; We must rename via copy.
+ (copy-file
+ filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid)
+ (if (file-directory-p filename)
+ (delete-directory filename 'recursive)
+ (delete-file filename)))))
+
+(defun tramp-smb-action-set-acl (proc vec)
+ "Read ACL data from connection buffer."
+ (when (not (memq (process-status proc) '(run open)))
+ ;; Accept pending output.
+ (while (tramp-accept-process-output proc 0.1))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (tramp-message vec 10 "\n%s" (buffer-string))
+ (throw 'tramp-action 'ok))))
+
+(defun tramp-smb-handle-set-file-acl (filename acl-string)
+ "Like `set-file-acl' for Tramp files."
+ (ignore-errors
+ (with-parsed-tramp-file-name filename nil
+ (when (and (stringp acl-string) (executable-find tramp-smb-acl-program))
+ (setq tramp-current-method (tramp-file-name-method v)
+ tramp-current-user (tramp-file-name-user v)
+ tramp-current-host (tramp-file-name-real-host v))
+ (tramp-set-file-property v localname "file-acl" 'undef)
+
+ (let* ((real-user (tramp-file-name-real-user v))
+ (real-host (tramp-file-name-real-host v))
+ (domain (tramp-file-name-domain v))
+ (port (tramp-file-name-port v))
+ (share (tramp-smb-get-share v))
+ (localname (replace-regexp-in-string
+ "\\\\" "/" (tramp-smb-get-localname v)))
+ (args (list (concat "//" real-host "/" share) "-E" "-S"
+ (replace-regexp-in-string
+ "\n" "," acl-string))))
+
+ (if (not (zerop (length real-user)))
+ (setq args (append args (list "-U" real-user)))
+ (setq args (append args (list "-N"))))
- (delete-file filename)))
+ (when domain (setq args (append args (list "-W" domain))))
+ (when port (setq args (append args (list "-p" port))))
+ (when tramp-smb-conf
+ (setq args (append args (list "-s" tramp-smb-conf))))
+ (setq
+ args
+ (append args (list (shell-quote-argument localname)
+ "&&" "echo" "tramp_exit_status" "0"
+ "||" "echo" "tramp_exit_status" "1")))
+
+ (unwind-protect
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ ;; Use an asynchronous processes. By this, password can
+ ;; be handled.
+ (let ((p (apply
+ 'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-acl-program args)))
+
+ (tramp-message
+ v 6 "%s" (mapconcat 'identity (process-command p) " "))
+ (tramp-set-connection-property p "vector" v)
+ (set-process-query-on-exit-flag p nil)
+ (tramp-process-actions p v nil tramp-smb-actions-set-acl)
+ (goto-char (point-max))
+ (unless (re-search-backward "tramp_exit_status [0-9]+" nil t)
+ (tramp-error
+ v 'file-error
+ "Couldn't find exit status of `%s'" tramp-smb-acl-program))
+ (skip-chars-forward "^ ")
+ (when (zerop (read (current-buffer)))
+ ;; Success.
+ (tramp-set-file-property v localname "file-acl" acl-string)
+ t)))
+
+ ;; Reset the transfer process properties.
+ (tramp-set-connection-property v "process-name" nil)
+ (tramp-set-connection-property v "process-buffer" nil)))))))
(defun tramp-smb-handle-set-file-modes (filename mode)
"Like `set-file-modes' for Tramp files."
(when (tramp-smb-get-cifs-capabilities v)
(tramp-flush-file-property v localname)
(unless (tramp-smb-send-command
- v (format "chmod \"%s\" %s"
- (tramp-smb-get-localname v)
- (tramp-compat-decimal-to-octal mode)))
+ v (format "chmod \"%s\" %o" (tramp-smb-get-localname v) mode))
(tramp-error
v 'file-error "Error while changing file's mode %s" filename)))))
+;; We use BUFFER also as connection buffer during setup. Because of
+;; this, its original contents must be saved, and restored once
+;; connection has been setup.
+(defun tramp-smb-handle-start-file-process (name buffer program &rest args)
+ "Like `start-file-process' for Tramp files."
+ (with-parsed-tramp-file-name default-directory nil
+ (let ((command (mapconcat 'identity (cons program args) " "))
+ (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
+ (name1 name)
+ (i 0))
+ (unwind-protect
+ (save-excursion
+ (save-restriction
+ (unless buffer
+ ;; BUFFER can be nil. We use a temporary buffer.
+ (setq buffer (generate-new-buffer tramp-temp-buffer-name)))
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name1)
+ (tramp-set-connection-property v "process-buffer" buffer)
+ ;; Activate narrowing in order to save BUFFER contents.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (let ((buffer-undo-list t))
+ (narrow-to-region (point-max) (point-max))
+ (tramp-smb-call-winexe v)
+ (when (tramp-smb-get-share v)
+ (tramp-smb-send-command
+ v (format
+ "cd \"//%s%s\""
+ host (file-name-directory localname))))
+ (tramp-message v 6 "(%s); exit" command)
+ (tramp-send-string v command)))
+ ;; Return value.
+ (tramp-get-connection-process v)))
+
+ ;; Save exit.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (if (string-match tramp-temp-buffer-name (buffer-name))
+ (progn
+ (set-process-buffer (tramp-get-connection-process v) nil)
+ (kill-buffer (current-buffer)))
+ (set-buffer-modified-p bmp)))
+ (tramp-set-connection-property v "process-name" nil)
+ (tramp-set-connection-property v "process-buffer" nil)))))
+
(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
"Like `write-region' for Tramp files."
(setq filename (expand-file-name filename))
(with-parsed-tramp-file-name filename nil
- (unless (eq append nil)
- (tramp-error
- v 'file-error "Cannot append to file using Tramp (`%s')" filename))
- ;; XEmacs takes a coding system as the seventh argument, not `confirm'.
- (when (and (not (featurep 'xemacs))
- confirm (file-exists-p filename))
+ (when (and confirm (file-exists-p filename))
(unless (y-or-n-p (format "File %s exists; overwrite anyway? "
filename))
(tramp-error v 'file-error "File not overwritten")))
(tramp-flush-file-property v localname)
(let ((curbuf (current-buffer))
(tmpfile (tramp-compat-make-temp-file filename)))
+ (when (and append (file-exists-p filename))
+ (copy-file filename tmpfile 'ok))
;; We say `no-message' here because we don't want the visited file
;; modtime data to be clobbered from the temp file. We call
;; `set-visited-file-modtime' ourselves later on.
(list start end tmpfile append 'no-message lockname confirm)
(list start end tmpfile append 'no-message lockname)))
- (tramp-with-progress-reporter
+ (with-tramp-progress-reporter
v 3 (format "Moving tmp file %s to %s" tmpfile filename)
(unwind-protect
(unless (tramp-smb-send-command
Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
(with-parsed-tramp-file-name (file-name-as-directory directory) nil
(setq localname (or localname "/"))
- (with-file-property v localname "file-entries"
- (with-current-buffer (tramp-get-buffer v)
+ (with-tramp-file-property v localname "file-entries"
+ (with-current-buffer (tramp-get-connection-buffer v)
(let* ((share (tramp-smb-get-share v))
(cache (tramp-get-connection-property v "share-cache" nil))
res entry)
(while (not (eobp))
(setq entry (tramp-smb-read-file-entry share))
(forward-line)
- (when entry (add-to-list 'res entry))))
+ (when entry (push entry res))))
;; Cache share entries.
(unless share
(tramp-set-connection-property v "share-cache" res)))
;; 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))
+ (push '("" "drwxrwxrwx" 0 (0 0)) res)
;; Return entries.
(delq nil res))))))
"%s%s"
(if (string-match "D" mode) "d" "-")
(mapconcat
- (lambda (x) "") " "
+ (lambda (_x) "") " "
(concat "r" (if (string-match "R" mode) "-" "w") "x"))))
line (substring line 0 -6))
(return))
;; 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
+ (with-tramp-connection-property
(tramp-get-connection-process vec) "cifs-capabilities"
(save-match-data
(when (tramp-smb-send-command vec "posix")
- (with-current-buffer (tramp-get-buffer vec)
+ (with-current-buffer (tramp-get-connection-buffer vec)
(goto-char (point-min))
(when
(re-search-forward "Server supports CIFS capabilities" nil t)
(member
"pathnames"
(split-string
- (buffer-substring (point) (point-at-eol)) nil t)))))))))
+ (buffer-substring (point) (point-at-eol)) nil 'omit)))))))))
(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
+ (if (and (tramp-smb-get-share vec)
+ (let ((p (tramp-get-connection-process vec)))
+ (and p (processp p) (memq (process-status p) '(run open)))))
+ (with-tramp-connection-property
(tramp-get-connection-process vec) "stat-capability"
- (tramp-smb-send-command vec "stat ."))))
+ (tramp-smb-send-command vec "stat \"/\""))))
;; Connection functions.
(tramp-send-string vec command)
(tramp-smb-wait-for-output vec))
-(defun tramp-smb-maybe-open-connection (vec)
+(defun tramp-smb-maybe-open-connection (vec &optional argument)
"Maybe open a connection to HOST, log in as USER, using `tramp-smb-program'.
Does not do anything if a connection is already open, but re-opens the
-connection if a previous connection has died for some reason."
+connection if a previous connection has died for some reason.
+If ARGUMENT is non-nil, use it as argument for
+`tramp-smb-winexe-program', and suppress any checks."
+ (tramp-check-proper-method-and-host vec)
+
(let* ((share (tramp-smb-get-share vec))
- (buf (tramp-get-buffer vec))
+ (buf (tramp-get-connection-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 (or argument (processp p))
(let ((default-directory (tramp-compat-temporary-file-directory))
(command (concat tramp-smb-program " -V")))
;; Check whether it is still the same share.
(unless
(and p (processp p) (memq (process-status p) '(run open))
- (string-equal
- share
- (tramp-get-connection-property p "smb-share" "")))
+ (or argument
+ (string-equal
+ share
+ (tramp-get-connection-property p "smb-share" ""))))
(save-match-data
;; There might be unread output from checking for share names.
(port (tramp-file-name-port vec))
args)
- (if share
- (setq args (list (concat "//" real-host "/" share)))
- (setq args (list "-g" "-L" real-host )))
+ (cond
+ (argument
+ (setq args (list (concat "//" real-host))))
+ (share
+ (setq args (list (concat "//" real-host "/" share))))
+ (t
+ (setq args (list "-g" "-L" real-host ))))
(if (not (zerop (length real-user)))
(setq args (append args (list "-U" real-user)))
(when port (setq args (append args (list "-p" port))))
(when tramp-smb-conf
(setq args (append args (list "-s" tramp-smb-conf))))
+ (when argument
+ (setq args (append args (list argument))))
;; OK, let's go.
- (tramp-with-progress-reporter
+ (with-tramp-progress-reporter
vec 3
(format "Opening connection for //%s%s/%s"
(if (not (zerop (length user))) (concat user "@") "")
(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-get-connection-name vec)
+ (tramp-get-connection-buffer vec)
+ (if argument
+ tramp-smb-winexe-program tramp-smb-program)
+ args))))
(tramp-message
vec 6 "%s" (mapconcat 'identity (process-command p) " "))
- (tramp-compat-set-process-query-on-exit-flag p nil)
+ (tramp-set-connection-property p "vector" vec)
+ (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 nil
- (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))))))))
+ (condition-case err
+ (let (tramp-message-show-message)
+ ;; Play login scenario.
+ (tramp-process-actions
+ p vec nil
+ (if (or argument share)
+ tramp-smb-actions-with-share
+ tramp-smb-actions-without-share))
+
+ ;; Check server version.
+ (unless argument
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (goto-char (point-min))
+ (search-forward-regexp tramp-smb-server-version 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 to 1. smbclient reads its input
+ ;; character by character; if we send the string
+ ;; at once, it is read painfully slow.
+ (tramp-set-connection-property p "smb-share" share)
+ (tramp-set-connection-property p "chunksize" 1))
+
+ ;; Check for the error reason. If it was due to wrong
+ ;; password, reestablish the connection. We cannot
+ ;; handle this in `tramp-process-actions', because
+ ;; smbclient does not ask for the password, again.
+ (error
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (goto-char (point-min))
+ (if (and (boundp 'auth-sources)
+ (symbol-value 'auth-sources)
+ (search-forward-regexp
+ tramp-smb-wrong-passwd-regexp nil t))
+ ;; Disable `auth-source' and `password-cache'.
+ (let (auth-sources)
+ (tramp-message
+ vec 3 "Retry connection with new password")
+ (tramp-cleanup-connection vec t)
+ (tramp-smb-maybe-open-connection vec argument))
+ ;; Propagate the error.
+ (signal (car err) (cdr err)))))))))))))
;; We don't use timeouts. If needed, the caller shall wrap around.
(defun tramp-smb-wait-for-output (vec)
"Wait for output from smbclient command.
Returns nil if an error message has appeared."
- (with-current-buffer (tramp-get-buffer vec)
+ (with-current-buffer (tramp-get-connection-buffer vec)
(let ((p (get-buffer-process (current-buffer)))
(found (progn (goto-char (point-min))
(re-search-forward tramp-smb-prompt nil t)))
(while (and (not found) (not err) (memq (process-status p) '(run open)))
;; Accept pending output.
- (tramp-accept-process-output p)
+ (tramp-accept-process-output p 0.1)
;; Search for prompt.
(goto-char (point-min))
(while (and (not found) (memq (process-status p) '(run open)))
;; Accept pending output.
- (tramp-accept-process-output p)
+ (tramp-accept-process-output p 0.1)
;; Search for prompt.
(goto-char (point-min))
(setq found (re-search-forward tramp-smb-prompt nil t)))
- ;; Return value is whether no error message has appeared.
(tramp-message vec 6 "\n%s" (buffer-string))
+
+ ;; Remove prompt.
+ (when found
+ (goto-char (point-max))
+ (re-search-backward tramp-smb-prompt nil t)
+ (delete-region (point) (point-max)))
+
+ ;; Return value is whether no error message has appeared.
(not err))))
+(defun tramp-smb-kill-winexe-function ()
+ "Send SIGKILL to the winexe process."
+ (ignore-errors
+ (let ((p (get-buffer-process (current-buffer))))
+ (when (and p (processp p) (memq (process-status p) '(run open)))
+ (signal-process (process-id p) 'SIGINT)))))
+
+(defun tramp-smb-call-winexe (vec)
+ "Apply a remote command, if possible, using `tramp-smb-winexe-program'."
+
+ ;; Check for program.
+ (unless (executable-find tramp-smb-winexe-program)
+ (tramp-error
+ vec 'file-error "Cannot find program: %s" tramp-smb-winexe-program))
+
+ ;; winexe does not supports ports.
+ (when (tramp-file-name-port vec)
+ (tramp-error vec 'file-error "Port not supported for remote processes"))
+
+ (tramp-smb-maybe-open-connection
+ vec
+ (format
+ "%s %s"
+ tramp-smb-winexe-shell-command tramp-smb-winexe-shell-command-switch))
+
+ (set (make-local-variable 'kill-buffer-hook)
+ '(tramp-smb-kill-winexe-function))
+
+ ;; Suppress "^M". Shouldn't we specify utf8?
+ (set-process-coding-system (tramp-get-connection-process vec) 'raw-text-dos)
+
+ ;; Set width to 128. This avoids mixing prompt and long error messages.
+ (tramp-smb-send-command vec "$rawui = (Get-Host).UI.RawUI")
+ (tramp-smb-send-command vec "$bufsize = $rawui.BufferSize")
+ (tramp-smb-send-command vec "$winsize = $rawui.WindowSize")
+ (tramp-smb-send-command vec "$bufsize.Width = 128")
+ (tramp-smb-send-command vec "$winsize.Width = 128")
+ (tramp-smb-send-command vec "$rawui.BufferSize = $bufsize")
+ (tramp-smb-send-command vec "$rawui.WindowSize = $winsize"))
+
+(defun tramp-smb-shell-quote-argument (s)
+ "Similar to `shell-quote-argument', but uses windows cmd syntax."
+ (let ((system-type 'ms-dos))
+ (shell-quote-argument s)))
+
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-smb 'force)))
;;; TODO:
-;; * Error handling in case password is wrong.
;; * Return more comprehensive file permission string.
;; * Try to remove the inclusion of dummy "" directory. Seems to be at
;; several places, especially in `tramp-smb-handle-insert-directory'.
-;; * (RMS) Use unwind-protect to clean up the state so as to make the state
-;; regular again.
;; * Ignore case in file names.
;;; tramp-smb.el ends here