diff options
Diffstat (limited to 'lisp/net/tramp-smb.el')
| -rw-r--r-- | lisp/net/tramp-smb.el | 375 |
1 files changed, 149 insertions, 226 deletions
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index cad6cb335cc..13d5e17a9ff 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -53,7 +53,7 @@ ;;;###tramp-autoload (tramp--with-startup (add-to-list 'tramp-default-user-alist - `(,(tramp-compat-rx bos (literal tramp-smb-method) eos) nil nil)) + `(,(rx bos (literal tramp-smb-method) eos) nil nil)) ;; Add completion function for SMB method. (tramp-set-completion-function @@ -92,9 +92,9 @@ this variable \"client min protocol=NT1\"." "Version string of the SMB client.") (defconst tramp-smb-server-version - (tramp-compat-rx "Domain=[" (* (not "]")) "] " - "OS=[" (* (not "]")) "] " - "Server=[" (* (not "]")) "]") + (rx "Domain=[" (* (not "]")) "] " + "OS=[" (* (not "]")) "] " + "Server=[" (* (not "]")) "]") "Regexp of SMB server identification.") (defconst tramp-smb-prompt @@ -269,6 +269,7 @@ See `tramp-actions-before-shell' for more info.") (file-symlink-p . tramp-handle-file-symlink-p) (file-system-info . tramp-smb-handle-file-system-info) (file-truename . tramp-handle-file-truename) + (file-user-uid . tramp-handle-file-user-uid) (file-writable-p . tramp-smb-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. @@ -487,9 +488,9 @@ arguments to pass to the OPERATION." (args (list (concat "//" host "/" share) "-E")) (options tramp-smb-options)) - (if (not (zerop (length user))) - (setq args (append args (list "-U" user))) - (setq args (append args (list "-N")))) + (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)))) @@ -558,7 +559,7 @@ arguments to pass to the OPERATION." (tramp-message v 6 "%s" (string-join (process-command p) " ")) - (process-put p 'vector v) + (process-put p 'tramp-vector v) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) @@ -691,35 +692,29 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; "rmdir" does not report an error. So we check ourselves. (when (file-exists-p directory) - (tramp-error v 'file-error "`%s' not removed." 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 - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (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))) - ;; Error. - (with-current-buffer (tramp-get-connection-buffer v) - (goto-char (point-min)) - (search-forward-regexp tramp-smb-errors nil t) - (tramp-error v 'file-error "%s `%s'" (match-string 0) filename))))))) + (tramp-skeleton-delete-file filename trash + (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))) + ;; Error. + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-min)) + (search-forward-regexp tramp-smb-errors nil t) + (tramp-error v 'file-error "%s `%s'" (match-string 0) filename))))) (defun tramp-smb-handle-expand-file-name (name &optional dir) "Like `expand-file-name' for Tramp files." ;; If DIR is not given, use DEFAULT-DIRECTORY or "/". (setq dir (or dir default-directory "/")) ;; Handle empty NAME. - (when (zerop (length name)) (setq name ".")) + (when (string-empty-p name) + (setq name ".")) ;; Unless NAME is absolute, concat DIR and NAME. (unless (file-name-absolute-p name) (setq name (tramp-compat-file-name-concat dir name))) @@ -730,12 +725,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (with-parsed-tramp-file-name name nil ;; Tilde expansion if necessary. (when (string-match - (tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl)) eos) - localname) + (rx bos "~" (group (* (not "/"))) (group (* nonl)) eos) localname) (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) hname) - (when (zerop (length uname)) + (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))))) @@ -789,9 +783,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (args (list (concat "//" host "/" share) "-E")) (options tramp-smb-options)) - (if (not (zerop (length user))) - (setq args (append args (list "-U" user))) - (setq args (append args (list "-N")))) + (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)))) @@ -806,32 +800,31 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (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 - ;; 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 process. 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" (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))))))))))))) + (with-tramp-saved-connection-properties + v '("process-name" "process-buffer") + (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 process. 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" (string-join (process-command p) " ")) + (process-put p 'tramp-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." @@ -982,18 +975,20 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; files. (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))))))) + (ignore-error file-missing + (all-completions + filename + (when (file-directory-p directory) + (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." @@ -1079,12 +1074,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setq entries (delq nil - (if (or wildcard (zerop (length base))) + (if (or wildcard (string-empty-p base)) ;; Check for matching entries. (mapcar (lambda (x) - (when (string-match-p - (tramp-compat-rx bol (literal base)) (nth 0 x)) + (when (string-match-p (rx bol (literal base)) (nth 0 x)) x)) entries) ;; We just need the only and only entry FILENAME. @@ -1105,7 +1099,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (when (tramp-compat-string-search "F" switches) (mapc (lambda (x) - (unless (zerop (length (car x))) + (unless (string-empty-p (car x)) (cond ((char-equal ?d (string-to-char (nth 1 x))) (setcar x (concat (car x) "/"))) @@ -1125,7 +1119,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; Print entries. (mapc (lambda (x) - (unless (zerop (length (nth 0 x))) + (unless (string-empty-p (nth 0 x)) (let ((attr (when (tramp-smb-get-stat-capability v) (ignore-errors @@ -1172,98 +1166,31 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (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))) - ;; Make missing directory parts. - (when (and parents - (tramp-smb-get-share v) - (not (file-directory-p ldir))) - (make-directory ldir parents)) - ;; Just do it. - (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)))) - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-properties v localname)) - (unless (file-directory-p dir) - (tramp-error v 'file-error "Couldn't make directory %s" dir))))) - -;; This is not used anymore. -(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)))) - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-properties v localname)) - (unless (file-directory-p directory) - (tramp-error v 'file-error "Couldn't make directory %s" directory)))) + (tramp-skeleton-make-directory dir parents + (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)))) + (unless (file-directory-p dir) + (tramp-error v 'file-error "Couldn't make directory %s" dir)))) (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 - ;; If TARGET is a Tramp name, use just the localname component. - ;; Don't check for a proper method. - (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))))) - - ;; If TARGET is still remote, quote it. - (if (tramp-tramp-file-p target) - (make-symbolic-link - (tramp-compat-file-name-quote target 'top) - linkname ok-if-already-exists) - - ;; Do the 'confirm if exists' thing. - (when (file-exists-p linkname) - ;; What to do? - (if (or (null ok-if-already-exists) ; not allowed to exist - (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")) - - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (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)))))) + (target linkname &optional ok-if-already-exists) + "Like `make-symbolic-link' for Tramp files." + (let ((v (tramp-dissect-file-name (expand-file-name linkname)))) + (unless (tramp-smb-get-cifs-capabilities v) + (tramp-error v 'file-error "make-symbolic-link not supported"))) + + (tramp-skeleton-handle-make-symbolic-link target linkname ok-if-already-exists + (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) @@ -1280,7 +1207,7 @@ component is used as the target of the symlink." ;; Determine input. (when infile - (setq infile (tramp-compat-file-name-unquote (expand-file-name infile))) + (setq infile (file-name-unquote (expand-file-name infile))) (if (tramp-equal-remote default-directory infile) ;; INFILE is on the same remote host. (setq input (tramp-unquote-file-local-name infile)) @@ -1455,9 +1382,9 @@ component is used as the target of the symlink." "\n" "," acl-string))) (options tramp-smb-options)) - (if (not (zerop (length user))) - (setq args (append args (list "-U" user))) - (setq args (append args (list "-N")))) + (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)))) @@ -1473,44 +1400,43 @@ component is used as the target of the symlink." "&&" "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 - ;; 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 process. 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" (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) - ;; This is meant for traces, and returning from - ;; the function. No error is propagated outside, - ;; due to the `ignore-errors' closure. - (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))) - ;; Success. - (tramp-set-file-property v localname "file-acl" acl-string) - t)))))))))) + (with-tramp-saved-connection-properties + v '("process-name" "process-buffer") + (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 process. 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" (string-join (process-command p) " ")) + (process-put p 'tramp-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) + ;; This is meant for traces, and returning from + ;; the function. No error is propagated outside, + ;; due to the `ignore-errors' closure. + (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))) + ;; Success. + (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." @@ -1588,7 +1514,7 @@ component is used as the target of the symlink." \"//\" substitutes only in the local filename part. Catches errors for shares like \"C$/\", which are common in Microsoft Windows." ;; Check, whether the local part is a quoted file name. - (if (tramp-compat-file-name-quoted-p filename) + (if (file-name-quoted-p filename) filename (with-parsed-tramp-file-name filename nil ;; Ignore in LOCALNAME everything before "//". @@ -1607,7 +1533,7 @@ 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 (zerop (length user)) + (unless (tramp-string-empty-or-nil-p user) (concat "/" user)))) (defun tramp-smb-handle-write-region @@ -1639,8 +1565,7 @@ VEC or USER, or if there is no home directory, return nil." "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) + (when (string-match (rx bol (? "/") (group (+ (not "/"))) "/") localname) (match-string 1 localname))))) (defun tramp-smb-get-localname (vec) @@ -1651,8 +1576,7 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"." (setq localname (if (string-match - (tramp-compat-rx bol (? "/") (+ (not "/")) (group "/" (* nonl))) - localname) + (rx bol (? "/") (+ (not "/")) (group "/" (* nonl))) localname) ;; There is a share, separated by "/". (if (not (tramp-smb-get-cifs-capabilities vec)) (mapconcat @@ -1660,8 +1584,7 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"." (match-string 1 localname) "") (match-string 1 localname)) ;; There is just a share. - (if (string-match - (tramp-compat-rx bol (? "/") (group (+ (not "/"))) eol) localname) + (if (string-match (rx bol (? "/") (group (+ (not "/"))) eol) localname) (match-string 1 localname) ""))) @@ -1789,8 +1712,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)." (if (not share) ;; Read share entries. - (when (string-match - (tramp-compat-rx bol "Disk|" (group (+ (not "|"))) "|") line) + (when (string-match (rx bol "Disk|" (group (+ (not "|"))) "|") line) (setq localname (match-string 1 line) mode "dr-xr-xr-x" size 0)) @@ -1956,7 +1878,7 @@ If ARGUMENT is non-nil, use it as argument for (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\n\r")) eos) 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)))) @@ -2009,9 +1931,9 @@ If ARGUMENT is non-nil, use it as argument for (t (setq args (list "-g" "-L" host )))) - (if (not (zerop (length user))) - (setq args (append args (list "-U" user))) - (setq args (append args (list "-N")))) + (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)))) @@ -2026,7 +1948,8 @@ If ARGUMENT is non-nil, use it as argument for (with-tramp-progress-reporter vec 3 (format "Opening connection for //%s%s/%s" - (if (not (zerop (length user))) (concat user "@") "") + (if (tramp-string-empty-or-nil-p user) + "" (concat user "@")) host (or share "")) (let* (coding-system-for-read @@ -2044,7 +1967,7 @@ If ARGUMENT is non-nil, use it as argument for args)))) (tramp-message vec 6 "%s" (string-join (process-command p) " ")) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) @@ -2098,7 +2021,7 @@ Removes smb prompt. Returns nil if an error message has appeared." ;; Read pending output. (while (not (re-search-forward tramp-smb-prompt nil t)) - (while (tramp-accept-process-output p 0)) + (while (tramp-accept-process-output p)) (goto-char (point-min))) (tramp-message vec 6 "\n%s" (buffer-string)) |