(eval-when-compile (require 'cl-lib))
(require 'tramp)
(defconst tramp-smb-method "smb"
"Method to connect SAMBA and M$ SMB servers.")
(unless (memq system-type '(cygwin windows-nt))
(tramp--with-startup
(add-to-list 'tramp-methods
`(,tramp-smb-method
(tramp-tmpdir "/C$/Temp")
(tramp-case-insensitive t)))))
(tramp--with-startup
(add-to-list 'tramp-default-user-alist
`(,(tramp-compat-rx bos (literal tramp-smb-method) eos) nil nil))
(tramp-set-completion-function
tramp-smb-method
'((tramp-parse-netrc "~/.netrc"))))
(defcustom tramp-smb-program "smbclient"
"Name of SMB client to run."
:group 'tramp
:type 'string)
(defcustom tramp-smb-acl-program "smbcacls"
"Name of SMB acls to run."
:group 'tramp
:type 'string
:version "24.4")
(defcustom tramp-smb-conf null-device
"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)))
(defcustom tramp-smb-options nil
"List of additional options.
They are added to the `tramp-smb-program' call via \"--option '...'\".
For example, if the deprecated SMB1 protocol shall be used, add to
this variable \"client min protocol=NT1\"."
:group 'tramp
:type '(repeat string)
:version "28.1")
(defvar tramp-smb-version nil
"Version string of the SMB client.")
(defconst tramp-smb-server-version
(tramp-compat-rx "Domain=[" (* (not "]")) "] "
"OS=[" (* (not "]")) "] "
"Server=[" (* (not "]")) "]")
"Regexp of SMB server identification.")
(defconst tramp-smb-prompt
(rx bol (| (: (| "smb:" "PS") blank (+ nonl) "> ")
(: (+ blank) "Server"
(+ blank) "Comment" eol)))
"Regexp used as prompt in smbclient or powershell.")
(defconst tramp-smb-wrong-passwd-regexp
(rx (| "NT_STATUS_LOGON_FAILURE"
"NT_STATUS_WRONG_PASSWORD"))
"Regexp for login error strings of SMB servers.")
(defconst tramp-smb-errors
(rx (| (: "Connection" (? " to " (+ (not blank))) " failed")
"Read from server failed, maybe it closed the connection"
"Call timed out: server did not respond"
(: (+ (not blank)) ": command not found")
"Server doesn't support UNIX CIFS calls"
(| "ERRDOS"
"ERRHRD"
"ERRSRV"
"ERRbadfile"
"ERRbadpw"
"ERRfilexists"
"ERRnoaccess"
"ERRnomem"
"ERRnosuchshare"
"NT_STATUS_ACCESS_DENIED"
"NT_STATUS_ACCOUNT_LOCKED_OUT"
"NT_STATUS_BAD_NETWORK_NAME"
"NT_STATUS_CANNOT_DELETE"
"NT_STATUS_CONNECTION_DISCONNECTED"
"NT_STATUS_CONNECTION_REFUSED"
"NT_STATUS_CONNECTION_RESET"
"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_INVALID_PARAMETER"
"NT_STATUS_INVALID_PARAMETER_MIX"
"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_NOT_A_DIRECTORY"
"NT_STATUS_NOT_SUPPORTED"
"NT_STATUS_OBJECT_NAME_COLLISION"
"NT_STATUS_OBJECT_NAME_INVALID"
"NT_STATUS_OBJECT_NAME_NOT_FOUND"
"NT_STATUS_OBJECT_PATH_SYNTAX_BAD"
"NT_STATUS_PASSWORD_MUST_CHANGE"
"NT_STATUS_RESOURCE_NAME_NOT_FOUND"
"NT_STATUS_REVISION_MISMATCH"
"NT_STATUS_SHARING_VIOLATION"
"NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE"
"NT_STATUS_UNSUCCESSFUL"
"NT_STATUS_WRONG_PASSWORD")))
"Regexp for possible error strings of SMB servers.
Used instead of analyzing error codes of commands.")
(defconst tramp-smb-actions-with-share
'((tramp-smb-prompt tramp-action-succeed)
(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-action-process-alive))
"List of pattern/action pairs.
This list is used for login to SMB servers.
See `tramp-actions-before-shell' for more info.")
(defconst tramp-smb-actions-without-share
'((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-action-out-of-band))
"List of pattern/action pairs.
This list is used for login to SMB servers.
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.")
(defconst tramp-smb-file-name-handler-alist
'((abbreviate-file-name . tramp-handle-abbreviate-file-name)
(access-file . tramp-handle-access-file)
(add-name-to-file . tramp-smb-handle-add-name-to-file)
(copy-directory . tramp-smb-handle-copy-directory)
(copy-file . tramp-smb-handle-copy-file)
(delete-directory . tramp-smb-handle-delete-directory)
(delete-file . tramp-smb-handle-delete-file)
(directory-file-name . tramp-handle-directory-file-name)
(directory-files . tramp-handle-directory-files)
(directory-files-and-attributes
. tramp-handle-directory-files-and-attributes)
(dired-compress-file . ignore)
(dired-uncache . tramp-handle-dired-uncache)
(exec-path . ignore)
(expand-file-name . tramp-smb-handle-expand-file-name)
(file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
(file-acl . tramp-smb-handle-file-acl)
(file-attributes . tramp-smb-handle-file-attributes)
(file-directory-p . tramp-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-locked-p . tramp-handle-file-locked-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-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
(file-name-completion . tramp-handle-file-name-completion)
(file-name-directory . tramp-handle-file-name-directory)
(file-name-nondirectory . tramp-handle-file-name-nondirectory)
(file-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)
(file-remote-p . tramp-handle-file-remote-p)
(file-selinux-context . tramp-handle-file-selinux-context)
(file-symlink-p . tramp-handle-file-symlink-p)
(file-system-info . tramp-smb-handle-file-system-info)
(file-truename . tramp-handle-file-truename)
(file-writable-p . tramp-smb-handle-file-writable-p)
(find-backup-file-name . tramp-handle-find-backup-file-name)
(insert-directory . tramp-smb-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
(list-system-processes . ignore)
(load . tramp-handle-load)
(lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-smb-handle-make-directory)
(make-directory-internal . ignore)
(make-lock-file-name . tramp-handle-make-lock-file-name)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
(make-symbolic-link . tramp-smb-handle-make-symbolic-link)
(memory-info . ignore)
(process-attributes . ignore)
(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 . ignore)
(set-file-times . 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)
(temporary-file-directory . tramp-handle-temporary-file-directory)
(tramp-get-home-directory . tramp-smb-handle-get-home-directory)
(tramp-get-remote-gid . ignore)
(tramp-get-remote-groups . ignore)
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
(unlock-file . tramp-handle-unlock-file)
(vc-registered . ignore)
(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.")
(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")
(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")
(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")
(defsubst tramp-smb-file-name-p (vec-or-filename)
"Check if it's a VEC-OR-FILENAME for SMB servers."
(when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
(string= (tramp-file-name-method vec) tramp-smb-method)))
(defun tramp-smb-file-name-handler (operation &rest args)
"Invoke the SMB related OPERATION and ARGS.
First arg specifies the OPERATION, second arg is a list of
arguments to pass to the OPERATION."
(if-let ((fn (assoc operation tramp-smb-file-name-handler-alist)))
(save-match-data (apply (cdr fn) args))
(tramp-run-real-handler operation args)))
(unless (memq system-type '(cygwin windows-nt))
(tramp--with-startup
(tramp-register-foreign-file-name-handler
#'tramp-smb-file-name-p #'tramp-smb-file-name-handler)))
(defun tramp-smb-handle-add-name-to-file
(filename newname &optional ok-if-already-exists)
"Like `add-name-to-file' for Tramp files."
(unless (tramp-equal-remote filename newname)
(with-parsed-tramp-file-name
(if (tramp-tramp-file-p filename) filename newname) nil
(tramp-error
v 'file-error
"add-name-to-file: %s"
"only implemented for same method, same user, same host")))
(with-parsed-tramp-file-name filename v1
(with-parsed-tramp-file-name newname v2
(when (file-directory-p filename)
(tramp-error
v2 'file-error
"add-name-to-file: %s must not be a directory" filename))
(when (file-exists-p newname)
(if (or (null ok-if-already-exists) (and (numberp ok-if-already-exists)
(not (yes-or-no-p
(format
"File %s already exists; make it a link anyway?"
v2-localname)))))
(tramp-error v2 'file-already-exists newname)
(delete-file newname)))
(tramp-flush-file-properties v2 v2-localname)
(unless (tramp-smb-send-command
v1
(format
"%s %s %s"
(if (tramp-smb-get-cifs-capabilities v1) "link" "hardlink")
(tramp-smb-shell-quote-localname v1)
(tramp-smb-shell-quote-localname v2)))
(tramp-error
v2 'file-error
"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 (process-live-p proc))
(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)
(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 copy-contents)
"Like `copy-directory' for Tramp files."
(tramp-skeleton-copy-directory
dirname newname keep-date parents copy-contents
(let ((t1 (tramp-tramp-file-p dirname))
(t2 (tramp-tramp-file-p newname))
target)
(with-parsed-tramp-file-name (if t1 dirname newname) nil
(unless (file-exists-p dirname)
(tramp-error v 'file-missing dirname))
(if (and (bound-and-true-p copy-directory-create-symlink)
(setq target (file-symlink-p dirname))
(tramp-equal-remote dirname newname))
(make-symbolic-link
target
(if (directory-name-p newname)
(concat newname (file-name-nondirectory dirname)) newname)
t)
(if copy-contents
(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))
(with-tramp-progress-reporter
v 0 (format "Copying %s to %s" dirname newname)
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-already-exists newname))
(cond
((and t1 t2)
(let ((tmpdir (tramp-compat-make-temp-name)))
(unwind-protect
(progn
(make-directory tmpdir)
(copy-directory
dirname (file-name-as-directory tmpdir)
keep-date 'parents)
(copy-directory
(expand-file-name
(file-name-nondirectory dirname) tmpdir)
newname keep-date parents))
(delete-directory tmpdir 'recursive))))
(nil (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))
(let* ((share (tramp-smb-get-share v))
(localname (file-name-as-directory
(tramp-compat-string-replace
"\\" "/" (tramp-smb-get-localname v))))
(tmpdir (tramp-compat-make-temp-name))
(args (list (concat "//" host "/" share) "-E"))
(options tramp-smb-options))
(if (tramp-string-empty-or-nil-p user)
(setq args (append args (list "-N")))
(setq args (append args (list "-U" user))))
(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))))
(while options
(setq args
(append args
`("--option" ,(format "%s" (car options))))
options (cdr options)))
(setq args
(if t1
(append args
(list "-D"
(tramp-unquote-shell-quote-argument
localname)
"-c"
(tramp-unquote-shell-quote-argument
"tar qc - *")
"|" "tar" "xfC" "-"
(tramp-unquote-shell-quote-argument
tmpdir)))
(append (list
"tar" "cfC" "-"
(tramp-unquote-shell-quote-argument dirname)
"." "|")
args
(list "-D" (tramp-unquote-shell-quote-argument
localname)
"-c" (tramp-unquote-shell-quote-argument
"tar qx -")))))
(unwind-protect
(with-tramp-saved-connection-properties
v '("process-name" "process-buffer")
(with-temp-buffer
(tramp-set-connection-property
v "process-name" (buffer-name (current-buffer)))
(tramp-set-connection-property
v "process-buffer" (current-buffer))
(when t1
(make-directory
(expand-file-name
".." (concat tmpdir localname))
'parents)
(make-symbolic-link
newname
(directory-file-name (concat tmpdir localname))))
(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" (string-join (process-command p) " "))
(process-put p 'vector v)
(process-put
p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil)
(tramp-process-actions
p v nil tramp-smb-actions-with-tar)
(while (process-live-p p)
(sleep-for 0.1))
(tramp-message v 6 "\n%s" (buffer-string)))))
(when t1 (delete-directory tmpdir 'recursive))))
(when keep-date
(tramp-compat-set-file-times
newname
(file-attribute-modification-time (file-attributes dirname))
(unless ok-if-already-exists 'nofollow)))
(unless keep-date
(set-file-modes newname (tramp-default-file-modes dirname)))
(when t2
(with-parsed-tramp-file-name newname nil
(tramp-flush-file-properties v localname))))
(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-extended-attributes)
"Like `copy-file' for Tramp files.
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))
(with-tramp-progress-reporter
(tramp-dissect-file-name
(if (tramp-tramp-file-p filename) filename newname))
0 (format "Copying %s to %s" filename newname)
(if (file-directory-p filename)
(copy-directory filename newname keep-date 'parents 'copy-contents)
(unless (file-exists-p filename)
(tramp-error
(tramp-dissect-file-name
(if (tramp-tramp-file-p filename) filename newname))
'file-missing filename))
(if-let ((tmpfile
(and (file-remote-p filename) (file-local-copy filename))))
(condition-case err
(rename-file tmpfile newname ok-if-already-exists)
((error quit)
(delete-file tmpfile)
(signal (car err) (cdr err))))
(when (and (file-directory-p newname)
(directory-name-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))
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(tramp-flush-file-properties 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"
(tramp-smb-shell-quote-argument filename)
(tramp-smb-shell-quote-localname v)))
(tramp-error
v 'file-error "Cannot copy `%s' to `%s'" filename newname)))))
(when keep-date
(tramp-compat-set-file-times
newname
(file-attribute-modification-time (file-attributes filename))
(unless ok-if-already-exists 'nofollow)))))
(defun tramp-smb-handle-delete-directory (directory &optional recursive trash)
"Like `delete-directory' for Tramp files."
(tramp-skeleton-delete-directory directory recursive trash
(when (file-exists-p directory)
(when recursive
(mapc
(lambda (file)
(if (file-directory-p file)
(delete-directory file recursive)
(delete-file file)))
(directory-files directory 'full directory-files-no-dot-files-regexp)))
(tramp-flush-directory-properties v localname)
(unless (tramp-smb-send-command
v (format
"%s %s"
(if (tramp-smb-get-cifs-capabilities v)
"posix_rmdir" "rmdir")
(tramp-smb-shell-quote-localname v)))
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(search-forward-regexp tramp-smb-errors nil t)
(tramp-error v 'file-error "%s `%s'" (match-string 0) directory)))
(when (file-exists-p directory)
(tramp-error v 'file-error "`%s' not removed." directory)))))
(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)
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
(if (and delete-by-moving-to-trash trash)
(move-file-to-trash filename)
(unless (tramp-smb-send-command
v (format
"%s %s"
(if (tramp-smb-get-cifs-capabilities v) "posix_unlink" "rm")
(tramp-smb-shell-quote-localname v)))
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(search-forward-regexp tramp-smb-errors nil t)
(tramp-error v 'file-error "%s `%s'" (match-string 0) filename)))))))
(defun tramp-smb-handle-expand-file-name (name &optional dir)
"Like `expand-file-name' for Tramp files."
(setq dir (or dir default-directory "/"))
(when (string-empty-p name)
(setq name "."))
(unless (file-name-absolute-p name)
(setq name (tramp-compat-file-name-concat dir name)))
(if (not (tramp-tramp-file-p name))
(tramp-run-real-handler #'expand-file-name (list name))
(with-parsed-tramp-file-name name nil
(when (string-match
(tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl)) eos)
localname)
(let ((uname (match-string 1 localname))
(fname (match-string 2 localname))
hname)
(when (tramp-string-empty-or-nil-p uname)
(setq uname user))
(when (setq hname (tramp-get-home-directory v uname))
(setq localname (concat hname fname)))))
(when (and (not tramp-tolerate-tilde)
(string-prefix-p "~" localname))
(tramp-error v 'file-error "Cannot expand tilde in file `%s'" name))
(unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
(setq localname (concat "/" localname)))
(when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname)
(setq localname "/"))
(tramp-make-tramp-file-name
v (if (string-prefix-p "~" localname)
localname
(tramp-run-real-handler #'expand-file-name (list localname)))))))
(defun tramp-smb-remote-acl-p (_vec)
"Check, whether ACL is enabled on the remote host."
(and (stringp tramp-smb-acl-program) (executable-find tramp-smb-acl-program)))
(defun tramp-smb-action-get-acl (proc vec)
"Read ACL data from connection buffer."
(unless (process-live-p proc)
(while (tramp-accept-process-output proc))
(with-current-buffer (tramp-get-connection-buffer vec)
(widen)
(tramp-message vec 10 "\n%s" (buffer-string))
(goto-char (point-min))
(while (and (not (eobp)) (not (looking-at-p (rx bol "REVISION:"))))
(forward-line)
(delete-region (point-min) (point)))
(while (and (not (eobp)) (looking-at-p (rx bol (+ nonl) ":" (+ nonl))))
(forward-line))
(delete-region (point) (point-max))
(throw 'tramp-action 'ok))))
(defun tramp-smb-handle-file-acl (filename)
"Like `file-acl' for Tramp files."
(ignore-errors
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-acl"
(when (tramp-smb-remote-acl-p v)
(let* ((share (tramp-smb-get-share v))
(localname (tramp-compat-string-replace
"\\" "/" (tramp-smb-get-localname v)))
(args (list (concat "//" host "/" share) "-E"))
(options tramp-smb-options))
(if (tramp-string-empty-or-nil-p user)
(setq args (append args (list "-N")))
(setq args (append args (list "-U" user))))
(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))))
(while options
(setq args
(append args `("--option" ,(format "%s" (car options))))
options (cdr options)))
(setq
args
(append args (list (tramp-unquote-shell-quote-argument localname)
(concat "2>" (tramp-get-remote-null-device v)))))
(unwind-protect
(with-tramp-saved-connection-properties
v '("process-name" "process-buffer")
(with-temp-buffer
(tramp-set-connection-property
v "process-name" (buffer-name (current-buffer)))
(tramp-set-connection-property
v "process-buffer" (current-buffer))
(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" (string-join (process-command p) " "))
(process-put p 'vector v)
(process-put p 'adjust-window-size-function #'ignore)
(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)))))))))))))
(defun tramp-smb-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-convert-file-attributes v localname id-format
(ignore-errors
(if (tramp-smb-get-stat-capability v)
(tramp-smb-do-file-attributes-with-stat v)
(let* ((entries (tramp-smb-get-file-entries
(file-name-directory filename)))
(entry (assoc (file-name-nondirectory filename) entries))
(inode (tramp-get-inode v))
(device (tramp-get-device v)))
(when entry
(list (and (tramp-compat-string-search "d" (nth 1 entry))
t) -1 (cons
tramp-unknown-id-string tramp-unknown-id-integer) (cons
tramp-unknown-id-string tramp-unknown-id-integer) tramp-time-dont-know (nth 3 entry) tramp-time-dont-know (nth 2 entry) (nth 1 entry) nil inode device))))))))
(defun tramp-smb-do-file-attributes-with-stat (vec)
"Implement `file-attributes' for Tramp files using `stat' command."
(tramp-message
vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec))
(let* (size id link uid gid atime mtime ctime mode inode)
(when (tramp-smb-send-command
vec (format "stat %s" (tramp-smb-shell-quote-localname vec)))
(with-current-buffer (tramp-get-connection-buffer vec)
(goto-char (point-min))
(unless (re-search-forward tramp-smb-errors nil t)
(while (not (eobp))
(cond
((looking-at
(rx "Size:" (+ blank) (group (+ digit)) (+ blank)
"Blocks:" (+ blank) (+ digit) (+ blank) (group (+ wordchar))))
(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
(rx "Inode:" (+ blank) (group (+ digit)) (+ blank)
"Links:" (+ blank) (group (+ digit))))
(setq inode (string-to-number (match-string 1))
link (string-to-number (match-string 2))))
((looking-at
(rx "Access:" (+ blank)
"(" (+ digit) "/" (group (+ (not blank))) ")" (+ blank)
"Uid:" (+ blank) (group (+ digit)) (+ blank)
"Gid:" (+ blank) (group (+ digit))))
(setq mode (match-string 1)
uid (match-string 2)
gid (match-string 3)))
((looking-at
(rx "Access:" (+ blank)
(group (+ digit)) "-" (group (+ digit)) "-"
(group (+ digit)) (+ blank)
(group (+ digit)) ":" (group (+ digit)) ":"
(group (+ digit))))
(setq atime
(encode-time
(string-to-number (match-string 6)) (string-to-number (match-string 5)) (string-to-number (match-string 4)) (string-to-number (match-string 3)) (string-to-number (match-string 2)) (string-to-number (match-string 1))))) ((looking-at
(rx "Modify:" (+ blank)
(group (+ digit)) "-" (group (+ digit)) "-"
(group (+ digit)) (+ blank)
(group (+ digit)) ":" (group (+ digit)) ":"
(group (+ digit))))
(setq mtime
(encode-time
(string-to-number (match-string 6)) (string-to-number (match-string 5)) (string-to-number (match-string 4)) (string-to-number (match-string 3)) (string-to-number (match-string 2)) (string-to-number (match-string 1))))) ((looking-at
(rx "Change:" (+ blank)
(group (+ digit)) "-" (group (+ digit)) "-"
(group (+ digit)) (+ blank)
(group (+ digit)) ":" (group (+ digit)) ":"
(group (+ digit))))
(setq ctime
(encode-time
(string-to-number (match-string 6)) (string-to-number (match-string 5)) (string-to-number (match-string 4)) (string-to-number (match-string 3)) (string-to-number (match-string 2)) (string-to-number (match-string 1)))))) (forward-line))
(when (and (stringp id)
(tramp-smb-send-command
vec
(format
"readlink %s" (tramp-smb-shell-quote-localname vec))))
(goto-char (point-min))
(and (looking-at (rx (+ nonl) " -> " (group (+ nonl))))
(setq id (match-string 1))))
(when (or id link uid gid atime mtime ctime size mode inode)
(list id link (cons uid (string-to-number uid))
(cons gid (string-to-number gid)) gid atime mtime ctime size
mode nil inode (tramp-get-device vec))))))))
(defun tramp-smb-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
(tramp-skeleton-file-local-copy filename
(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"
(tramp-smb-shell-quote-localname v)
(tramp-smb-shell-quote-argument tmpfile)))
(delete-file tmpfile)
(tramp-error
v 'file-error "Cannot make local copy of file `%s'" filename)))))
(defun tramp-smb-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
(all-completions
filename
(with-parsed-tramp-file-name (expand-file-name directory) nil
(with-tramp-file-property v localname "file-name-all-completions"
(delete-dups
(mapcar
(lambda (x)
(list
(if (tramp-compat-string-search "d" (nth 1 x))
(file-name-as-directory (nth 0 x))
(nth 0 x))))
(tramp-smb-get-file-entries directory)))))))
(defun tramp-smb-handle-file-system-info (filename)
"Like `file-system-info' for Tramp files."
(ignore-errors
(unless (file-directory-p filename)
(setq filename (file-name-directory filename)))
(with-parsed-tramp-file-name (expand-file-name filename) nil
(when (tramp-smb-get-share v)
(tramp-message v 5 "file system info: %s" localname)
(tramp-smb-send-command
v (format "du %s/*" (tramp-smb-shell-quote-localname v)))
(with-current-buffer (tramp-get-connection-buffer v)
(let (total avail blocksize)
(goto-char (point-min))
(forward-line)
(when (looking-at
(rx (* blank) (group (+ digit))
" blocks of size " (group (+ digit))
". " (group (+ digit)) " blocks available"))
(setq blocksize (string-to-number (match-string 2))
total (* blocksize (string-to-number (match-string 1)))
avail (* blocksize (string-to-number (match-string 3)))))
(forward-line)
(when (looking-at (rx "Total number of bytes: " (group (+ digit))))
(tramp-set-file-property
v localname "used-bytes" (string-to-number (match-string 1))))
(when (and total avail)
(list total (- total avail) avail))))))))
(defun tramp-smb-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
(if (file-exists-p filename)
(tramp-compat-string-search
"w" (or (file-attribute-modes (file-attributes filename)) ""))
(let ((dir (file-name-directory filename)))
(and (file-exists-p dir)
(file-writable-p dir)))))
(defun tramp-smb-handle-insert-directory
(filename switches &optional wildcard full-directory-p)
"Like `insert-directory' for Tramp files."
(setq filename (expand-file-name filename))
(unless switches (setq switches ""))
(when (and (directory-name-p filename)
(not full-directory-p))
(setq switches (concat switches "F")))
(if full-directory-p
(setq filename (file-name-as-directory filename))
(setq filename (directory-file-name filename)))
(unless wildcard
(access-file filename "Reading directory"))
(with-parsed-tramp-file-name filename nil
(with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
(save-match-data
(let ((base (file-name-nondirectory filename))
(entries (copy-tree
(tramp-smb-get-file-entries
(file-name-directory filename))))
(avail (get-free-disk-space filename))
(used
(format
"%.0f"
(/ (tramp-get-file-property v localname "used-bytes" 0) 1024))))
(when wildcard
(string-match (rx ".") base)
(setq base (replace-match "\\\\." nil nil base))
(string-match (rx "*") base)
(setq base (replace-match ".*" nil nil base))
(string-match (rx "?") base)
(setq base (replace-match ".?" nil nil base)))
(setq entries
(delq
nil
(if (or wildcard (string-empty-p base))
(mapcar
(lambda (x)
(when (string-match-p
(tramp-compat-rx bol (literal base)) (nth 0 x))
x))
entries)
(list (assoc base entries)))))
(setq entries
(sort
entries
(lambda (x y)
(if (tramp-compat-string-search "t" switches)
(time-less-p (nth 3 y) (nth 3 x))
(string-lessp (nth 0 x) (nth 0 y))))))
(when (tramp-compat-string-search "F" switches)
(mapc
(lambda (x)
(unless (string-empty-p (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))
(when full-directory-p
(insert
(if (and avail
(not (fboundp 'dired--insert-disk-space)))
(format "total used in directory %s available %s\n" used avail)
(format "total %s\n" used))))
(mapc
(lambda (x)
(unless (string-empty-p (nth 0 x))
(let ((attr
(when (tramp-smb-get-stat-capability v)
(ignore-errors
(file-attributes
(expand-file-name
(nth 0 x) (file-name-directory filename))
'string)))))
(when (tramp-compat-string-search "l" switches)
(insert
(format
"%10s %3d %-8s %-8s %8s %s "
(or (file-attribute-modes attr) (nth 1 x))
(or (file-attribute-link-number attr) 1)
(or (file-attribute-user-id attr) "nobody")
(or (file-attribute-group-id attr) "nogroup")
(or (file-attribute-size attr) (nth 2 x))
(format-time-string
(if (time-less-p
(time-since (nth 3 x)) (days-to-time 183))
"%b %e %R"
"%b %e %Y")
(nth 3 x)))))
(let ((start (point)))
(insert
(file-relative-name
(expand-file-name
(nth 0 x) (file-name-directory filename))
(when full-directory-p (file-name-directory filename))))
(put-text-property start (point) 'dired-filename t))
(when (and (tramp-compat-string-search "l" switches)
(stringp (file-attribute-type attr)))
(insert " -> " (file-attribute-type attr))))
(insert "\n")
(beginning-of-line)))
entries))))))
(defun tramp-smb-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
(setq dir (directory-file-name (expand-file-name dir)))
(unless (file-name-absolute-p dir)
(setq dir (expand-file-name dir default-directory)))
(with-parsed-tramp-file-name dir nil
(when (and (null parents) (file-exists-p dir))
(tramp-error v 'file-already-exists dir))
(let* ((ldir (file-name-directory dir)))
(when (and parents
(tramp-smb-get-share v)
(not (file-directory-p ldir)))
(make-directory ldir parents))
(when (file-directory-p ldir)
(tramp-smb-send-command
v (if (tramp-smb-get-cifs-capabilities v)
(format "posix_mkdir %s %o"
(tramp-smb-shell-quote-localname v) (default-file-modes))
(format "mkdir %s" (tramp-smb-shell-quote-localname v))))
(tramp-flush-file-properties v localname))
(unless (file-directory-p dir)
(tramp-error v 'file-error "Couldn't make directory %s" dir)))))
(defun tramp-smb-handle-make-directory-internal (directory)
"Like `make-directory-internal' for Tramp files."
(declare (obsolete nil "29.1"))
(setq directory (directory-file-name (expand-file-name directory)))
(unless (file-name-absolute-p directory)
(setq directory (expand-file-name directory default-directory)))
(with-parsed-tramp-file-name directory nil
(when (file-directory-p (file-name-directory directory))
(tramp-smb-send-command
v (if (tramp-smb-get-cifs-capabilities v)
(format "posix_mkdir %s %o"
(tramp-smb-shell-quote-localname v) (default-file-modes))
(format "mkdir %s" (tramp-smb-shell-quote-localname v))))
(tramp-flush-file-properties v localname))
(unless (file-directory-p directory)
(tramp-error v 'file-error "Couldn't make directory %s" directory))))
(defun tramp-smb-handle-make-symbolic-link
(target linkname &optional ok-if-already-exists)
"Like `make-symbolic-link' for Tramp files.
If TARGET is a non-Tramp file, it is used verbatim as the target
of the symlink. If TARGET is a Tramp file, only the localname
component is used as the target of the symlink."
(with-parsed-tramp-file-name linkname nil
(let ((non-essential t))
(when (and (tramp-tramp-file-p target)
(tramp-file-name-equal-p v (tramp-dissect-file-name target)))
(setq target (tramp-file-local-name (expand-file-name target))))
(tramp-flush-file-properties
v (expand-file-name target (tramp-file-local-name default-directory))))
(if (tramp-tramp-file-p target)
(make-symbolic-link
(tramp-compat-file-name-quote target 'top)
linkname ok-if-already-exists)
(when (file-exists-p linkname)
(if (or (null ok-if-already-exists) (and (numberp ok-if-already-exists)
(not (yes-or-no-p
(format
"File %s already exists; make it a link anyway?"
localname)))))
(tramp-error v 'file-already-exists localname)
(delete-file linkname)))
(unless (tramp-smb-get-cifs-capabilities v)
(tramp-error v 'file-error "make-symbolic-link not supported"))
(tramp-flush-file-properties v localname)
(unless (tramp-smb-send-command
v (format "symlink %s %s"
(tramp-smb-shell-quote-argument target)
(tramp-smb-shell-quote-localname v)))
(tramp-error
v 'file-error
"error with make-symbolic-link, see buffer `%s' for details"
(tramp-get-connection-buffer v))))))
(defun tramp-smb-handle-process-file
(program &optional infile destination display &rest args)
"Like `process-file' for Tramp files."
(when (and (numberp destination) (zerop destination))
(error "Implementation does not handle immediate return"))
(with-parsed-tramp-file-name (expand-file-name default-directory) nil
(let* ((name (file-name-nondirectory program))
(name1 name)
(i 0)
input tmpinput outbuf command ret)
(when infile
(setq infile (tramp-compat-file-name-unquote (expand-file-name infile)))
(if (tramp-equal-remote default-directory infile)
(setq input (tramp-unquote-file-local-name infile))
(setq input (tramp-make-tramp-temp-file v)
tmpinput (tramp-make-tramp-file-name v input))
(copy-file infile tmpinput t))
(setq input (format "//%s%s" host input)))
(cond
((bufferp destination)
(setq outbuf destination))
((stringp destination)
(setq outbuf (get-buffer-create destination)))
((consp destination)
(cond
((bufferp (car destination))
(setq outbuf (car destination)))
((stringp (car destination))
(setq outbuf (get-buffer-create (car destination))))
((car destination)
(setq outbuf (current-buffer))))
(tramp-message v 2 "%s" "STDERR not supported"))
(destination
(setq outbuf (current-buffer))))
(setq command (string-join (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)
(setq i (1+ i)
name1 (format "%s<%d>" name i)))
(condition-case nil
(with-tramp-saved-connection-properties
v '("process-name" "process-buffer")
(tramp-set-connection-property v "process-name" name1)
(tramp-set-connection-property
v "process-buffer"
(or outbuf (generate-new-buffer tramp-temp-buffer-name)))
(with-current-buffer (tramp-get-connection-buffer v)
(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
(tramp-smb-shell-quote-argument
(file-name-directory localname)))))
(tramp-smb-send-command v command)
(narrow-to-region (point-max) (point-max))
(let ((p (tramp-get-connection-process v)))
(tramp-smb-send-command v "exit $lasterrorcode")
(while (process-live-p p)
(sleep-for 0.1)
(setq ret (process-exit-status p))))
(delete-region (point-min) (point-max))
(widen)))
(quit
(setq ret -1))
(error
(setq ret 1)))
(when (and display outbuf (get-buffer-window outbuf t)) (redisplay))
(when tmpinput (delete-file tmpinput))
(unless outbuf
(kill-buffer (tramp-get-connection-property v "process-buffer")))
(when process-file-side-effects
(tramp-flush-directory-properties v "/"))
(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))
(with-parsed-tramp-file-name
(if (tramp-tramp-file-p filename) filename newname) nil
(unless (file-exists-p filename)
(tramp-error v 'file-missing filename))
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(with-tramp-progress-reporter
v 0 (format "Renaming %s to %s" filename newname)
(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))))
(with-parsed-tramp-file-name filename v1
(with-parsed-tramp-file-name newname v2
(tramp-flush-file-properties v1 v1-localname)
(tramp-flush-file-properties 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-shell-quote-localname v1)
(tramp-smb-shell-quote-localname v2)))
(tramp-error v2 'file-error "Cannot rename `%s'" filename))))
(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)
"Set ACL data."
(unless (process-live-p proc)
(while (tramp-accept-process-output proc))
(tramp-message
vec 10 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec)))
(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
(tramp-flush-file-property v localname "file-acl")
(when (and (stringp acl-string) (tramp-smb-remote-acl-p v))
(let* ((share (tramp-smb-get-share v))
(localname (tramp-compat-string-replace
"\\" "/" (tramp-smb-get-localname v)))
(args (list (concat "//" host "/" share) "-E" "-S"
(tramp-compat-string-replace
"\n" "," acl-string)))
(options tramp-smb-options))
(if (tramp-string-empty-or-nil-p user)
(setq args (append args (list "-N")))
(setq args (append args (list "-U" user))))
(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))))
(while options
(setq args
(append args `("--option" ,(format "%s" (car options))))
options (cdr options)))
(setq
args
(append args (list (tramp-unquote-shell-quote-argument localname)
"&&" "echo" "tramp_exit_status" "0"
"||" "echo" "tramp_exit_status" "1")))
(unwind-protect
(with-tramp-saved-connection-properties
v '("process-name" "process-buffer")
(with-temp-buffer
(tramp-set-connection-property
v "process-name" (buffer-name (current-buffer)))
(tramp-set-connection-property
v "process-buffer" (current-buffer))
(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" (string-join (process-command p) " "))
(process-put p 'vector v)
(process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil)
(tramp-process-actions p v nil tramp-smb-actions-set-acl)
(unless
(tramp-search-regexp (rx "tramp_exit_status " (+ digit)))
(tramp-error
v 'file-error
"Couldn't find exit status of `%s'"
tramp-smb-acl-program))
(skip-chars-forward "^ ")
(when (zerop (read (current-buffer)))
(tramp-set-file-property v localname "file-acl" acl-string)
t))))))))))
(defun tramp-smb-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
(unless (and (eq flag 'nofollow) (file-symlink-p filename))
(tramp-skeleton-set-file-modes-times-uid-gid filename
(when (tramp-smb-get-cifs-capabilities v)
(unless (tramp-smb-send-command
v
(format "chmod %s %o" (tramp-smb-shell-quote-localname v) mode))
(tramp-error
v 'file-error "Error while changing file's mode %s" filename))))))
(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* ((buffer
(if buffer
(get-buffer-create buffer)
(generate-new-buffer tramp-temp-buffer-name)))
(command (string-join (cons program args) " "))
(bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
(name1 name)
(i 0)
p)
(unwind-protect
(with-tramp-saved-connection-properties
v '("process-name" "process-buffer")
(save-excursion
(save-restriction
(while (get-process name1)
(setq i (1+ i)
name1 (format "%s<%d>" name i)))
(tramp-set-connection-property v "process-name" name1)
(tramp-set-connection-property v "process-buffer" buffer)
(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
(tramp-smb-shell-quote-argument
(file-name-directory localname)))))
(tramp-message v 6 "(%s); exit" command)
(tramp-send-string v command)))
(setq p (tramp-get-connection-process v))
(when program
(process-put p 'remote-command (cons program args))
(tramp-set-connection-property
p "remote-command" (cons program args)))
p)))
(with-current-buffer (tramp-get-connection-buffer v)
(if (tramp-compat-string-search 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)))))))
(defun tramp-smb-handle-substitute-in-file-name (filename)
"Like `substitute-in-file-name' for Tramp files.
\"//\" substitutes only in the local filename part. Catches
errors for shares like \"C$/\", which are common in Microsoft Windows."
(if (tramp-compat-file-name-quoted-p filename)
filename
(with-parsed-tramp-file-name filename nil
(when (and (stringp localname)
(string-match (rx (+? nonl) "/" (group (| "/" "~"))) localname))
(setq filename
(concat (file-remote-p filename)
(replace-match "\\1" nil nil localname)))))
(condition-case nil
(tramp-run-real-handler #'substitute-in-file-name (list filename))
(error filename))))
(defun tramp-smb-handle-get-home-directory (vec &optional user)
"The remote home directory for connection VEC as local file name.
If USER is a string, return its home directory instead of the
user identified by VEC. If there is no user specified in either
VEC or USER, or if there is no home directory, return nil."
(let ((user (or user (tramp-file-name-user vec))))
(unless (tramp-string-empty-or-nil-p user)
(concat "/" user))))
(defun tramp-smb-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
(tramp-skeleton-write-region start end filename append visit lockname mustbenew
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok))
(let (create-lockfiles)
(write-region start end tmpfile append 'no-message))
(with-tramp-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"
(tramp-smb-shell-quote-argument tmpfile)
(tramp-smb-shell-quote-localname v)))
(tramp-error v 'file-error "Cannot write `%s'" filename))
(delete-file tmpfile))))))
(defun tramp-smb-get-share (vec)
"Return the share name of LOCALNAME."
(save-match-data
(let ((localname (tramp-file-name-unquote-localname vec)))
(when (string-match
(tramp-compat-rx bol (? "/") (group (+ (not "/"))) "/") localname)
(match-string 1 localname)))))
(defun tramp-smb-get-localname (vec)
"Return the file name of LOCALNAME.
If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"."
(save-match-data
(let ((localname (tramp-file-name-unquote-localname vec)))
(setq
localname
(if (string-match
(tramp-compat-rx bol (? "/") (+ (not "/")) (group "/" (* nonl)))
localname)
(if (not (tramp-smb-get-cifs-capabilities vec))
(mapconcat
(lambda (x) (if (equal x ?/) "\\" (char-to-string x)))
(match-string 1 localname) "")
(match-string 1 localname))
(if (string-match
(tramp-compat-rx bol (? "/") (group (+ (not "/"))) eol) localname)
(match-string 1 localname)
"")))
(when (string-match (rx (group "$$") (| "/" eol)) localname)
(setq localname (replace-match "$" nil nil localname 1)))
(when (string-match-p (rx blank eol) localname)
(tramp-error
vec 'file-error
"Invalid file name %s" (tramp-make-tramp-file-name vec localname)))
localname)))
(defun tramp-smb-get-file-entries (directory)
"Read entries which match DIRECTORY.
Either the shares are listed, or the `dir' command is executed.
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-tramp-file-property v localname "file-entries"
(let* ((share (tramp-smb-get-share v))
(cache (tramp-get-connection-property v "share-cache"))
res entry)
(if (and (not share) cache)
(setq res cache)
(if share
(tramp-smb-send-command
v (format "dir %s*" (tramp-smb-shell-quote-localname v)))
(tramp-smb-maybe-open-connection v))
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(if (re-search-forward tramp-smb-errors nil t)
(tramp-error v 'file-error "%s `%s'" (match-string 0) directory)
(while (not (eobp))
(setq entry (tramp-smb-read-file-entry share))
(forward-line)
(when entry (push entry res)))))
(unless share
(tramp-set-connection-property v "share-cache" res)))
(push '("" "drwxrwxrwx" 0 (0 0)) res)
(delq nil res)))))
(defun tramp-smb-read-file-entry (share)
"Parse entry in SMB output buffer.
If SHARE is result, entries are of type dir. Otherwise, shares
are listed. Result is the list (LOCALNAME MODE SIZE MTIME)."
(let ((line (buffer-substring (point) (line-end-position)))
localname mode size month day hour min sec year mtime)
(if (not share)
(when (string-match
(tramp-compat-rx bol "Disk|" (group (+ (not "|"))) "|") line)
(setq localname (match-string 1 line)
mode "dr-xr-xr-x"
size 0))
(cl-block nil
(if (string-match (rx (group (+ digit)) eol) line)
(setq year (string-to-number (match-string 1 line))
line (substring line 0 -5))
(cl-return))
(if (string-match
(rx (group (+ digit)) ":"
(group (+ digit)) ":"
(group (+ digit)) eol)
line)
(setq hour (string-to-number (match-string 1 line))
min (string-to-number (match-string 2 line))
sec (string-to-number (match-string 3 line))
line (substring line 0 -9))
(cl-return))
(if (string-match (rx (group (+ digit)) eol) line)
(setq day (string-to-number (match-string 1 line))
line (substring line 0 -3))
(cl-return))
(if (string-match (rx (group (+ wordchar)) eol) line)
(setq month (match-string 1 line)
line (substring line 0 -4))
(cl-return))
(if (string-match-p (rx (+ wordchar) eol) line)
(setq line (substring line 0 -5))
(cl-return))
(if (string-match (rx (group (+ digit)) eol) line)
(let ((length (- (max 10 (1+ (length (match-string 1 line)))))))
(setq size (string-to-number (match-string 1 line)))
(when (string-match
(rx (+ (any "ACDEHNORSTVrs"))) (substring line length))
(setq length (+ length (match-end 0))))
(setq line (substring line 0 length)))
(cl-return))
(if (string-match (rx (? (group (+ (any "ACDEHNORSTVrs")))) eol) line)
(setq
mode (or (match-string 1 line) "")
mode (format
"%s%s"
(if (tramp-compat-string-search "D" mode) "d" "-")
(mapconcat
(lambda (_x) "") " "
(format
"r%sx"
(if (tramp-compat-string-search "R" mode) "-" "w"))))
line (substring line 0 -6))
(cl-return))
(if (string-match
(rx bol (+ blank)
(group (not blank) (? (* nonl) (not blank)))
(* blank) eol)
line)
(setq localname (match-string 1 line))
(cl-return))))
(when (and localname mode size)
(setq mtime
(if (and sec min hour day month year)
(encode-time
sec min hour day
(cdr
(assoc
(downcase month)
(default-toplevel-value 'parse-time-months)))
year)
tramp-time-dont-know))
(list localname mode size mtime))))
(defun tramp-smb-get-cifs-capabilities (vec)
"Check whether the SMB server supports POSIX commands."
(if (and (process-live-p (tramp-get-connection-process vec))
(tramp-get-connection-property vec "posix" t))
(with-tramp-connection-property
(tramp-get-process vec) "cifs-capabilities"
(save-match-data
(when (tramp-smb-send-command vec "posix")
(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) (line-end-position))
nil 'omit)))))))))
(defun tramp-smb-get-stat-capability (vec)
"Check whether the SMB server supports the `stat' command."
(if (and (tramp-smb-get-share vec)
(process-live-p (tramp-get-connection-process vec)))
(with-tramp-connection-property (tramp-get-process vec) "stat-capability"
(tramp-smb-send-command vec "stat /"))))
(defun tramp-smb-send-command (vec command)
"Send the COMMAND to connection VEC.
Returns nil if there has been an error message from smbclient."
(tramp-smb-maybe-open-connection vec)
(tramp-message vec 6 "%s" command)
(tramp-send-string vec command)
(tramp-smb-wait-for-output 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.
If ARGUMENT is non-nil, use it as argument for
`tramp-smb-winexe-program', and suppress any checks."
(unless (tramp-connectable-p vec)
(throw 'non-essential 'non-essential))
(let* ((share (tramp-smb-get-share vec))
(buf (tramp-get-connection-buffer vec))
(p (get-buffer-process buf)))
(unless (or argument (processp p))
(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 (rx (+ (any " \t\r\n")) eos) 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-properties vec "/")
(tramp-flush-connection-properties vec))
(tramp-set-connection-property
vec "smbclient-version" tramp-smb-version)))
(with-current-buffer buf
(goto-char (point-min))
(when (and (time-less-p
60 (time-since
(tramp-get-connection-property p "last-cmd-time" 0)))
(process-live-p p)
(re-search-forward tramp-smb-errors nil t))
(delete-process p)
(setq p nil)))
(unless (and (process-live-p p)
(or argument
(string-equal
share
(tramp-get-connection-property p "smb-share" ""))))
(save-match-data
(when buf (with-current-buffer buf (erase-buffer)))
(when (and p (processp p)) (delete-process p))
(let* ((user (tramp-file-name-user vec))
(host (tramp-file-name-host vec))
(domain (tramp-file-name-domain vec))
(port (tramp-file-name-port vec))
(options tramp-smb-options)
args)
(cond
(argument
(setq args (list (concat "//" host))))
(share
(setq args (list (concat "//" host "/" share))))
(t
(setq args (list "-g" "-L" host ))))
(if (tramp-string-empty-or-nil-p user)
(setq args (append args (list "-N")))
(setq args (append args (list "-U" user))))
(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))))
(dolist (option options)
(setq args (append args (list "--option" option))))
(when argument
(setq args (append args (list argument))))
(with-tramp-progress-reporter
vec 3
(format "Opening connection for //%s%s/%s"
(if (tramp-string-empty-or-nil-p user)
"" (concat user "@"))
host (or share ""))
(let* (coding-system-for-read
(process-connection-type tramp-process-connection-type)
(p (let ((default-directory
tramp-compat-temporary-file-directory)
(process-environment
(cons (concat "TERM=" tramp-terminal-type)
process-environment)))
(apply #'start-process
(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" (string-join (process-command p) " "))
(process-put p 'vector vec)
(process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil)
(tramp-set-connection-local-variables vec)
(condition-case err
(let ((inhibit-message t))
(tramp-process-actions
p vec nil
(if (or argument share)
tramp-smb-actions-with-share
tramp-smb-actions-without-share))
(tramp-set-connection-property p "smb-share" share)
(tramp-set-connection-property p "chunksize" 1)
(tramp-set-connection-property p "connected" t))
(error
(with-current-buffer (tramp-get-connection-buffer vec)
(goto-char (point-min))
(if (and (bound-and-true-p auth-sources)
(search-forward-regexp
tramp-smb-wrong-passwd-regexp nil t))
(let (auth-sources)
(tramp-message
vec 3 "Retry connection with new password")
(tramp-cleanup-connection vec t)
(tramp-smb-maybe-open-connection vec argument))
(signal (car err) (cdr err)))))))))))))
(defun tramp-smb-wait-for-output (vec)
"Wait for output from smbclient command.
Removes smb prompt. Returns nil if an error message has appeared."
(with-current-buffer (tramp-get-connection-buffer vec)
(let ((p (get-buffer-process (current-buffer)))
(inhibit-read-only t))
(while (not (re-search-forward tramp-smb-prompt nil t))
(while (tramp-accept-process-output p 0))
(goto-char (point-min)))
(tramp-message vec 6 "\n%s" (buffer-string))
(goto-char (point-min))
(when (re-search-forward tramp-smb-prompt nil t)
(goto-char (point-max))
(re-search-backward tramp-smb-prompt nil t)
(delete-region (point) (point-max)))
(goto-char (point-min))
(not (re-search-forward tramp-smb-errors nil t)))))
(defun tramp-smb-kill-winexe-function ()
"Send SIGKILL to the winexe process."
(ignore-errors
(let ((p (get-buffer-process (current-buffer))))
(when (process-live-p p)
(signal-process (process-id p) 'SIGINT)))))
(defun tramp-smb-call-winexe (vec)
"Apply a remote command, if possible, using `tramp-smb-winexe-program'."
(unless (executable-find tramp-smb-winexe-program)
(tramp-error
vec 'file-error "Cannot find program: %s" tramp-smb-winexe-program))
(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))
(add-hook 'kill-buffer-hook #'tramp-smb-kill-winexe-function nil t)
(set-process-coding-system (tramp-get-connection-process vec) 'raw-text-dos)
(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))
(tramp-unquote-shell-quote-argument s)))
(defun tramp-smb-shell-quote-localname (vec)
"Call `tramp-smb-shell-quote-argument' on localname of VEC."
(tramp-smb-shell-quote-argument (tramp-smb-get-localname vec)))
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-smb 'force)))
(provide 'tramp-smb)