[Emacs-diffs] emacs-26 a9ac20c 1/2: Add support for `file-system-info' in Tramp

[Michael Albinus]

branch: emacs-26
commit a9ac20c179e62f69c77a068f6107e4b186e4c24d
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    Add support for `file-system-info' in Tramp
    
    * 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.
---
 lisp/net/tramp-adb.el        | 25 ++++++++++++++++++++
 lisp/net/tramp-gvfs.el       | 56 +++++++++++++++++++++++++++++++++++++-------
 lisp/net/tramp-sh.el         | 47 +++++++++++++++++++++++++++++++++++++
 lisp/net/tramp-smb.el        | 48 ++++++++++++++++++++++++++++++++++++-
 lisp/net/tramp.el            |  4 +++-
 test/lisp/net/tramp-tests.el | 29 ++++++++++++++++++-----
 6 files changed, 193 insertions(+), 16 deletions(-)

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 760d020..5268e80 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 e55dd11..237d689 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 a744a53..bdb7a13 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 35aa811..620c938 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 e253db0..ac882ab 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 d430cae..a8fe06d 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]."