(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)
(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)
":[[: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'.")
+
\f
;; New handlers should be added here.
;;;###tramp-autoload
(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)
(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
(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))))))
(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
(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)
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.
'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)
(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"
(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)
(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)
;; 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)
(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)
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))
(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)
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."
(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))
(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
(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)
;; * 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]."
projects / emacs.git / commitdiff