diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 760d020f672..5268e80a33d 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -139,6 +139,7 @@ It is used for TCP/IP devices." (file-remote-p . tramp-handle-file-remote-p) (file-selinux-context . ignore) (file-symlink-p . tramp-handle-file-symlink-p) + (file-system-info . tramp-adb-handle-file-system-info) (file-truename . tramp-adb-handle-file-truename) (file-writable-p . tramp-adb-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) @@ -255,6 +256,30 @@ pass to the OPERATION." (file-attributes (file-truename filename))) t)) +(defun tramp-adb-handle-file-system-info (filename) + "Like `file-system-info' for Tramp files." + (ignore-errors + (with-parsed-tramp-file-name (expand-file-name filename) nil + (tramp-message v 5 "file system info: %s" localname) + (tramp-adb-send-command + v (format "df -k %s" (tramp-shell-quote-argument localname))) + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-min)) + (forward-line) + (when (looking-at + (concat "[[:space:]]*[^[:space:]]+" + "[[:space:]]+\\([[:digit:]]+\\)" + "[[:space:]]+\\([[:digit:]]+\\)" + "[[:space:]]+\\([[:digit:]]+\\)")) + ;; The values are given as 1k numbers, so we must change + ;; them to number of bytes. + (list (* 1024 (string-to-number (concat (match-string 1) "e0"))) + ;; The second value is the used size. We need the + ;; free size. + (* 1024 (- (string-to-number (concat (match-string 1) "e0")) + (string-to-number (concat (match-string 2) "e0")))) + (* 1024 (string-to-number (concat (match-string 3) "e0"))))))))) + ;; This is derived from `tramp-sh-handle-file-truename'. Maybe the ;; code could be shared? (defun tramp-adb-handle-file-truename (filename) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index e55dd1178d2..237d6896e2a 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -448,6 +448,18 @@ Every entry is a list (NAME ADDRESS).") ":[[:blank:]]+\\(.*\\)$") "Regexp to parse GVFS file attributes with `gvfs-info'.") +(defconst tramp-gvfs-file-system-attributes + '("filesystem::free" + "filesystem::size" + "filesystem::used") + "GVFS file system attributes.") + +(defconst tramp-gvfs-file-system-attributes-regexp + (concat "^[[:blank:]]*" + (regexp-opt tramp-gvfs-file-system-attributes t) + ":[[:blank:]]+\\(.*\\)$") + "Regexp to parse GVFS file system attributes with `gvfs-info'.") + ;; New handlers should be added here. ;;;###tramp-autoload @@ -494,6 +506,7 @@ Every entry is a list (NAME ADDRESS).") (file-remote-p . tramp-handle-file-remote-p) (file-selinux-context . ignore) (file-symlink-p . tramp-handle-file-symlink-p) + (file-system-info . tramp-gvfs-handle-file-system-info) (file-truename . tramp-handle-file-truename) (file-writable-p . tramp-gvfs-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) @@ -825,7 +838,7 @@ file names." (let ((last-coding-system-used last-coding-system-used) result) (with-parsed-tramp-file-name directory nil - (with-tramp-file-property v localname "directory-gvfs-attributes" + (with-tramp-file-property v localname "directory-attributes" (tramp-message v 5 "directory gvfs attributes: %s" localname) ;; Send command. (tramp-gvfs-send-command @@ -860,23 +873,34 @@ file names." (forward-line))) result))))) -(defun tramp-gvfs-get-root-attributes (filename) - "Return GVFS attributes association list of FILENAME." +(defun tramp-gvfs-get-root-attributes (filename &optional file-system) + "Return GVFS attributes association list of FILENAME. +If FILE-SYSTEM is non-nil, return file system attributes." (ignore-errors ;; Don't modify `last-coding-system-used' by accident. (let ((last-coding-system-used last-coding-system-used) result) (with-parsed-tramp-file-name filename nil - (with-tramp-file-property v localname "file-gvfs-attributes" - (tramp-message v 5 "file gvfs attributes: %s" localname) + (with-tramp-file-property + v localname + (if file-system "file-system-attributes" "file-attributes") + (tramp-message + v 5 "file%s gvfs attributes: %s" + (if file-system " system" "") localname) ;; Send command. - (tramp-gvfs-send-command - v "gvfs-info" (tramp-gvfs-url-file-name filename)) + (if file-system + (tramp-gvfs-send-command + v "gvfs-info" "--filesystem" (tramp-gvfs-url-file-name filename)) + (tramp-gvfs-send-command + v "gvfs-info" (tramp-gvfs-url-file-name filename))) ;; Parse output. (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) (while (re-search-forward - tramp-gvfs-file-attributes-with-gvfs-info-regexp nil t) + (if file-system + tramp-gvfs-file-system-attributes-regexp + tramp-gvfs-file-attributes-with-gvfs-info-regexp) + nil t) (push (cons (match-string 1) (match-string 2)) result)) result)))))) @@ -1127,6 +1151,22 @@ file-notify events." (with-tramp-file-property v localname "file-readable-p" (tramp-check-cached-permissions v ?r)))) +(defun tramp-gvfs-handle-file-system-info (filename) + "Like `file-system-info' for Tramp files." + (setq filename (directory-file-name (expand-file-name filename))) + (with-parsed-tramp-file-name filename nil + ;; We don't use cached values. + (tramp-set-file-property v localname "file-system-attributes" 'undef) + (let* ((attr (tramp-gvfs-get-root-attributes filename 'file-system)) + (size (cdr (assoc "filesystem::size" attr))) + (used (cdr (assoc "filesystem::used" attr))) + (free (cdr (assoc "filesystem::free" attr)))) + (when (and (stringp size) (stringp used) (stringp free)) + (list (string-to-number (concat size "e0")) + (- (string-to-number (concat size "e0")) + (string-to-number (concat used "e0"))) + (string-to-number (concat free "e0"))))))) + (defun tramp-gvfs-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." (with-parsed-tramp-file-name filename nil diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index a744a53ca42..bdb7a132408 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1020,6 +1020,7 @@ of command line.") (file-remote-p . tramp-handle-file-remote-p) (file-selinux-context . tramp-sh-handle-file-selinux-context) (file-symlink-p . tramp-handle-file-symlink-p) + (file-system-info . tramp-sh-handle-file-system-info) (file-truename . tramp-sh-handle-file-truename) (file-writable-p . tramp-sh-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) @@ -2739,6 +2740,17 @@ The method used must be an out-of-band method." beg 'noerror) (replace-match (file-relative-name filename) t)) + ;; Try to insert the amount of free space. + (goto-char (point-min)) + ;; First find the line to put it on. + (when (re-search-forward "^\\([[:space:]]*total\\)" nil t) + (let ((available (get-free-disk-space "."))) + (when available + ;; Replace "total" with "total used", to avoid confusion. + (replace-match "\\1 used in directory") + (end-of-line) + (insert " available " available)))) + (goto-char (point-max))))))) ;; Canonicalization of file names. @@ -3701,6 +3713,30 @@ file-notify events." 'file-notify-handle-event `(file-notify ,object file-notify-callback))))))) +(defun tramp-sh-handle-file-system-info (filename) + "Like `file-system-info' for Tramp files." + (ignore-errors + (with-parsed-tramp-file-name (expand-file-name filename) nil + (when (tramp-get-remote-df v) + (tramp-message v 5 "file system info: %s" localname) + (tramp-send-command + v (format + "%s --block-size=1 --output=size,used,avail %s" + (tramp-get-remote-df v) (tramp-shell-quote-argument localname))) + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-min)) + (forward-line) + (when (looking-at + (concat "[[:space:]]*\\([[:digit:]]+\\)" + "[[:space:]]+\\([[:digit:]]+\\)" + "[[:space:]]+\\([[:digit:]]+\\)")) + (list (string-to-number (concat (match-string 1) "e0")) + ;; The second value is the used size. We need the + ;; free size. + (- (string-to-number (concat (match-string 1) "e0")) + (string-to-number (concat (match-string 2) "e0"))) + (string-to-number (concat (match-string 3) "e0"))))))))) + ;;; Internal Functions: (defun tramp-maybe-send-script (vec script name) @@ -5404,6 +5440,17 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil." (delete-file tmpfile)) result))) +(defun tramp-get-remote-df (vec) + "Determine remote `df' command." + (with-tramp-connection-property vec "df" + (tramp-message vec 5 "Finding a suitable `df' command") + (let ((result (tramp-find-executable vec "df" (tramp-get-remote-path vec)))) + (and + result + (tramp-send-command-and-check + vec (format "%s --block-size=1 --output=size,used,avail /" result)) + result)))) + (defun tramp-get-remote-gvfs-monitor-dir (vec) "Determine remote `gvfs-monitor-dir' command." (with-tramp-connection-property vec "gvfs-monitor-dir" diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 35aa8110946..620c93828da 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -255,6 +255,7 @@ See `tramp-actions-before-shell' for more info.") (file-remote-p . tramp-handle-file-remote-p) ;; `file-selinux-context' performed by default handler. (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) @@ -954,6 +955,38 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (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 + (tramp-message v 5 "file system info: %s" localname) + (tramp-smb-send-command v (format "du %s/*" (tramp-smb-get-localname v))) + (with-current-buffer (tramp-get-connection-buffer v) + (let (total avail blocksize) + (goto-char (point-min)) + (forward-line) + (when (looking-at + (concat "[[:space:]]*\\([[:digit:]]+\\)" + " blocks of size \\([[:digit:]]+\\)" + "\\. \\([[:digit:]]+\\) blocks available")) + (setq blocksize (string-to-number (concat (match-string 2) "e0")) + total (* blocksize + (string-to-number (concat (match-string 1) "e0"))) + avail (* blocksize + (string-to-number (concat (match-string 3) "e0"))))) + (forward-line) + (when (looking-at "Total number of bytes: \\([[:digit:]]+\\)") + ;; The used number of bytes is not part of the result. As + ;; side effect, we store it as file property. + (tramp-set-file-property + v localname "used-bytes" + (string-to-number (concat (match-string 1) "e0")))) + ;; Result. + (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) @@ -984,7 +1017,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; We should not destroy the cache entry. (entries (copy-sequence (tramp-smb-get-file-entries - (file-name-directory filename))))) + (file-name-directory filename)))) + (avail (get-free-disk-space filename)) + ;; `get-free-disk-space' calls `file-system-info', which + ;; sets file property "used-bytes" as side effect. + (used + (format + "%.0f" + (/ (tramp-get-file-property v localname "used-bytes" 0) 1024)))) (when wildcard (string-match "\\." base) @@ -1032,6 +1072,12 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setcar x (concat (car x) "*")))))) entries)) + ;; Insert size information. + (insert + (if avail + (format "total used in directory %s available %s\n" used avail) + (format "total %s\n" used))) + ;; Print entries. (mapc (lambda (x) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index e253db0883c..ac882abae54 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2079,7 +2079,9 @@ ARGS are the arguments OPERATION has been called with." substitute-in-file-name unhandled-file-name-directory vc-registered ;; Emacs 26+ only. - file-name-case-insensitive-p)) + file-name-case-insensitive-p + ;; Emacs 27+ only. + file-system-info)) (if (file-name-absolute-p (nth 0 args)) (nth 0 args) default-directory)) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index d430caec8aa..a8fe06d4e67 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3438,7 +3438,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (fboundp 'connection-local-set-profiles))) ;; `connection-local-set-profile-variables' and - ;; `connection-local-set-profiles' exists since Emacs 26. We don't + ;; `connection-local-set-profiles' exist since Emacs 26. We don't ;; want to see compiler warnings for older Emacsen. (let ((default-directory tramp-test-temporary-file-directory) explicit-shell-file-name kill-buffer-query-functions) @@ -4108,12 +4108,29 @@ Use the `ls' command." tramp-connection-properties))) (tramp--test-utf8))) +(ert-deftest tramp-test37-file-system-info () + "Check that `file-system-info' returns proper values." + (skip-unless (tramp--test-enabled)) + ;; Since Emacs 27.1. + (skip-unless (fboundp 'file-system-info)) + + ;; `file-system-info' exists since Emacs 27. We don't + ;; want to see compiler warnings for older Emacsen. + (let ((fsi (with-no-warnings + (file-system-info tramp-test-temporary-file-directory)))) + (skip-unless fsi) + (should (and (consp fsi) + (= (length fsi) 3) + (numberp (nth 0 fsi)) + (numberp (nth 1 fsi)) + (numberp (nth 2 fsi)))))) + (defun tramp--test-timeout-handler () (interactive) (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test))))) ;; This test is inspired by Bug#16928. -(ert-deftest tramp-test37-asynchronous-requests () +(ert-deftest tramp-test38-asynchronous-requests () "Check parallel asynchronous requests. Such requests could arrive from timers, process filters and process sentinels. They shall not disturb each other." @@ -4270,7 +4287,7 @@ process sentinels. They shall not disturb each other." (ignore-errors (cancel-timer timer)) (ignore-errors (delete-directory tmp-name 'recursive))))))) -(ert-deftest tramp-test38-recursive-load () +(ert-deftest tramp-test39-recursive-load () "Check that Tramp does not fail due to recursive load." (skip-unless (tramp--test-enabled)) @@ -4293,7 +4310,7 @@ process sentinels. They shall not disturb each other." (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument code)))))))) -(ert-deftest tramp-test39-remote-load-path () +(ert-deftest tramp-test40-remote-load-path () "Check that Tramp autoloads its packages with remote `load-path'." ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el. ;; It shall still work, when a remote file name is in the @@ -4316,7 +4333,7 @@ process sentinels. They shall not disturb each other." (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test40-unload () +(ert-deftest tramp-test41-unload () "Check that Tramp and its subpackages unload completely. Since it unloads Tramp, it shall be the last test to run." :tags '(:expensive-test) @@ -4374,7 +4391,7 @@ Since it unloads Tramp, it shall be the last test to run." ;; * Fix `tramp-test05-expand-file-name-relative' in `expand-file-name'. ;; * Fix `tramp-test06-directory-file-name' for `ftp'. ;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?). -;; * Fix Bug#16928 in `tramp-test37-asynchronous-requests'. +;; * Fix Bug#16928 in `tramp-test38-asynchronous-requests'. (defun tramp-test-all (&optional interactive) "Run all tests for \\[tramp]."