procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add support for `file-system-info' in Tramp

Browse source 
* lisp/net/tramp.el (tramp-file-name-for-operation):
Add `file-system-info'.

* lisp/net/tramp-adb.el (tramp-adb-handle-file-system-info): New defun.
(tramp-adb-file-name-handler-alist): Use it.

* lisp/net/tramp-gvfs.el (tramp-gvfs-file-system-attributes)
(tramp-gvfs-file-system-attributes-regexp): New defconst.
(tramp-gvfs-handle-file-system-info): New defun.
(tramp-gvfs-file-name-handler-alist): Use it.
(tramp-gvfs-get-directory-attributes): Fix property name.
(tramp-gvfs-get-root-attributes): Support also file system attributes.

* lisp/net/tramp-sh.el (tramp-sh-handle-file-system-info): New defun.
(tramp-sh-file-name-handler-alist): Use it.
(tramp-sh-handle-insert-directory): Insert size information.
(tramp-get-remote-df): New defun.

* lisp/net/tramp-smb.el (tramp-smb-handle-file-system-info): New defun.
(tramp-smb-file-name-handler-alist): Use it.
(tramp-smb-handle-insert-directory): Insert size information.

* test/lisp/net/tramp-tests.el (tramp-test37-file-system-info):
New test.
(tramp-test38-asynchronous-requests)
(tramp-test39-recursive-load, tramp-test40-remote-load-path)
(tramp-test41-unload): Rename.
This commit is contained in:
Michael Albinus 2017-10-03 16:07:32 +02:00
parent 0fff900c18
commit a9ac20c179
6 changed files with 193 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
lisp/net/tramp-adb.el
View file

@ -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)

56
lisp/net/tramp-gvfs.el
View file

@ -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

47
lisp/net/tramp-sh.el
View file

@ -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"

48
lisp/net/tramp-smb.el
View file

@ -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)

4
lisp/net/tramp.el
View file

@ -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))

29
test/lisp/net/tramp-tests.el
View file

@ -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]."