master bfb7c58ac5c: Optimizations on Tramp symlink handling

[Michael Albinus]

branch: master
commit bfb7c58ac5c322d6363e83f68afa88fc88ba2a0f
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    Optimizations on Tramp symlink handling
    
    * lisp/net/tramp-sh.el (cl-seq): Require.
    (tramp-perl-file-truename): Print also whether the file is a symlink.
    (tramp-bundle-read-file-names): Rename from
    `tramp-vc-registered-read-file-names'.  Print also the
    `file-directory-p: value.
    (tramp-sh-handle-make-symbolic-link): Combine two commands.  Use
    `tramp-skeleton-make-symbolic-link'.
    (tramp-sh-handle-file-truename): Read also "file-symlink-marker"
    property.
    (tramp-sh-handle-file-directory-p): Simplify if-let clause.
    (tramp-sh-handle-file-name-all-completions): Simplify command.
    (tramp-bundle-read-file-names): New defun.
    (tramp-sh-handle-vc-registered, tramp-get-remote-path): Use it.
    (tramp-open-shell): Flush "scripts" connection property.
    (tramp-open-connection-setup-interactive-shell): Combine two commands.
    
    * lisp/net/tramp-smb.el (tramp-smb-handle-make-symbolic-link):
    * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-make-symbolic-link):
    Use `tramp-skeleton-make-symbolic-link'.
    
    * lisp/net/tramp.el (tramp-skeleton-make-symbolic-link): Rename from
    `tramp-skeleton-handle-make-symbolic-link'.
    (tramp-handle-file-symlink-p): Check file property
    "file-symlink-marker".
---
 lisp/net/tramp-adb.el      |   4 +-
 lisp/net/tramp-sh.el       | 193 +++++++++++++++++++++++++--------------------
 lisp/net/tramp-smb.el      |   2 +-
 lisp/net/tramp-sudoedit.el |   6 +-
 lisp/net/tramp.el          |  14 +++-
 5 files changed, 125 insertions(+), 94 deletions(-)

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 3d4dacb393c..eec00b17b4c 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -511,9 +511,9 @@ Emacs dired can't find files."
   (with-parsed-tramp-file-name (expand-file-name filename) nil
     (with-tramp-file-property v localname "file-writable-p"
       (if (file-exists-p filename)
+         ;; Examine `file-attributes' cache to see if request can be
+         ;; satisfied without remote operation.
          (if (tramp-file-property-p v localname "file-attributes")
-             ;; Examine `file-attributes' cache to see if request can
-             ;; be satisfied without remote operation.
              (tramp-check-cached-permissions v ?w)
            (tramp-adb-send-command-and-check
             v (format "test -w %s" (tramp-shell-quote-argument localname))))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index e889cb2e86f..b33e788b893 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -32,6 +32,7 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl-lib))
+(require 'cl-seq)
 (require 'tramp)
 
 ;; `dired-*' declarations can be removed, starting with Emacs 29.1.
@@ -616,6 +617,13 @@ if (!$result) {
     $result = File::Spec->catpath($vol, File::Spec->catdir(@dirs), \"\");
 }
 
+if (-l $ARGV[0]) {
+    print \"t\\n\";
+    }
+else {
+    print \"nil\\n\";
+    }
+
 $result =~ s/\"/\\\\\"/g;
 print \"\\\"$result\\\"\\n\";
 ' \"$1\" %n"
@@ -699,11 +707,11 @@ characters need to be doubled.")
     " '((%s%%%%N%s) %%%%h (%s%%%%U%s . %%%%u) (%s%%%%G%s . %%%%g)"
     " %%%%X %%%%Y %%%%Z %%%%s %s%%%%A%s t %%%%i -1)' \"$1\" %%n || echo nil) |"
     " sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'")
-    tramp-stat-marker tramp-stat-marker ; %%N
-    tramp-stat-marker tramp-stat-marker ; %%U
-    tramp-stat-marker tramp-stat-marker ; %%G
-    tramp-stat-marker tramp-stat-marker ; %%A
-    tramp-stat-quoted-marker)
+   tramp-stat-marker tramp-stat-marker ; %%N
+   tramp-stat-marker tramp-stat-marker ; %%U
+   tramp-stat-marker tramp-stat-marker ; %%G
+   tramp-stat-marker tramp-stat-marker ; %%A
+   tramp-stat-quoted-marker)
   "Shell function to produce output suitable for use with `file-attributes'
 on the remote file system.
 Format specifiers are replaced by `tramp-expand-script', percent
@@ -1015,7 +1023,7 @@ BEGIN {
 Format specifiers are replaced by `tramp-expand-script', percent
 characters need to be doubled.")
 
-(defconst tramp-vc-registered-read-file-names
+(defconst tramp-bundle-read-file-names
   "echo \"(\"
 while read file; do
     quoted=`echo \"$file\" | sed -e \"s/\\\"/\\\\\\\\\\\\\\\\\\\"/\"`
@@ -1029,13 +1037,18 @@ while read file; do
     else
        echo \"(\\\"$quoted\\\" \\\"file-readable-p\\\" nil)\"
     fi
+    if %s \"$file\"; then
+       echo \"(\\\"$quoted\\\" \\\"file-directory-p\\\" t)\"
+    else
+       echo \"(\\\"$quoted\\\" \\\"file-directory-p\\\" nil)\"
+    fi
 done
 echo \")\""
-  "Script to check existence of VC related files.
-It must be send formatted with two strings; the tests for file
-existence, and file readability.  Input shall be read via
-here-document, otherwise the command could exceed maximum length
-of command line.
+  "Script to check file attributes of a bundle of files.
+It must be sent formatted with three strings; the tests for file
+existence, file readability, and file directory.  Input shall be
+read via here-document, otherwise the command could exceed
+maximum length of command line.
 Format specifiers \"%s\" are replaced before the script is used.")
 
 ;; New handlers should be added here.
@@ -1145,19 +1158,17 @@ Operations not mentioned here will be handled by the 
normal Emacs functions.")
        (concat "Making a symbolic link: "
               "ln(1) does not exist on the remote host"))))
 
-  (tramp-skeleton-handle-make-symbolic-link target linkname 
ok-if-already-exists
-    (and (tramp-send-command-and-check
-         v (format
-            "cd %s"
-            (tramp-shell-quote-argument (file-name-directory localname))))
-         (tramp-send-command-and-check
-         v (format
-            "%s -sf %s %s" (tramp-get-remote-ln v)
-            (tramp-shell-quote-argument target)
-            ;; The command could exceed PATH_MAX, so we use relative
-            ;; file names.
-            (tramp-shell-quote-argument
-              (concat "./" (file-name-nondirectory localname))))))))
+  (tramp-skeleton-make-symbolic-link target linkname ok-if-already-exists
+    (tramp-send-command-and-check
+     v (format
+       "cd %s && %s -sf %s %s"
+       (tramp-shell-quote-argument (file-name-directory localname))
+       (tramp-get-remote-ln v)
+       (tramp-shell-quote-argument target)
+       ;; The command could exceed PATH_MAX, so we use relative
+       ;; file names.
+       (tramp-shell-quote-argument
+         (concat "./" (file-name-nondirectory localname)))))))
 
 (defun tramp-sh-handle-file-truename (filename)
   "Like `file-truename' for Tramp files."
@@ -1166,12 +1177,20 @@ Operations not mentioned here will be handled by the 
normal Emacs functions.")
      ;; Use GNU readlink --canonicalize-missing where available.
      ((tramp-get-remote-readlink v)
       (tramp-send-command-and-check
-       v (format "%s --canonicalize-missing %s"
-                (tramp-get-remote-readlink v)
-                (tramp-shell-quote-argument localname)))
+       v (format
+         (concat
+          "(if %s -h \"%s\"; then echo t; else echo nil; fi) && "
+          "%s --canonicalize-missing %s")
+         (tramp-get-test-command v)
+         (tramp-shell-quote-argument localname)
+         (tramp-get-remote-readlink v)
+         (tramp-shell-quote-argument localname)))
       (with-current-buffer (tramp-get-connection-buffer v)
        (goto-char (point-min))
-       (buffer-substring (point-min) (line-end-position))))
+       (tramp-set-file-property v localname "file-symlink-marker" (read 
(current-buffer)))
+       ;; We cannote call `read', the file name isn't quoted.
+       (forward-line)
+       (buffer-substring (point) (line-end-position))))
 
      ;; Use Perl implementation.
      ((and (tramp-get-remote-perl v)
@@ -1179,9 +1198,13 @@ Operations not mentioned here will be handled by the 
normal Emacs functions.")
           (tramp-get-connection-property v "perl-cwd-realpath"))
       (tramp-maybe-send-script
        v tramp-perl-file-truename "tramp_perl_file_truename")
-      (tramp-send-command-and-read
+      (tramp-send-command-and-check
        v (format "tramp_perl_file_truename %s"
-                (tramp-shell-quote-argument localname))))
+                (tramp-shell-quote-argument localname)))
+      (with-current-buffer (tramp-get-connection-buffer v)
+        (goto-char (point-min))
+       (tramp-set-file-property v localname "file-symlink-marker" (read 
(current-buffer)))
+       (read (current-buffer))))
 
      ;; Do it yourself.
      (t (tramp-file-local-name
@@ -1675,8 +1698,8 @@ ID-FORMAT valid values are `string' and `integer'."
        (with-tramp-file-property v localname "file-directory-p"
          (if-let
              ((truename (tramp-get-file-property v localname "file-truename"))
-              (attr-p (tramp-file-property-p
-                       v (tramp-file-local-name truename) "file-attributes")))
+              ((tramp-file-property-p
+                v (tramp-file-local-name truename) "file-attributes")))
              (eq (file-attribute-type
                   (tramp-get-file-property
                    v (tramp-file-local-name truename) "file-attributes"))
@@ -1688,9 +1711,9 @@ ID-FORMAT valid values are `string' and `integer'."
   (with-parsed-tramp-file-name (expand-file-name filename) nil
     (with-tramp-file-property v localname "file-writable-p"
       (if (file-exists-p filename)
+         ;; Examine `file-attributes' cache to see if request can be
+         ;; satisfied without remote operation.
          (if (tramp-file-property-p v localname "file-attributes")
-             ;; Examine `file-attributes' cache to see if request can
-             ;; be satisfied without remote operation.
              (tramp-check-cached-permissions v ?w)
            (tramp-run-test v "-w" localname))
        ;; If file doesn't exist, check if directory is writable.
@@ -1789,7 +1812,7 @@ ID-FORMAT valid values are `string' and `integer'."
                               "cd %s 2>&1 && %s -a 2>%s"
                               " | while IFS= read f; do"
                               " if %s -d \"$f\" 2>%s;"
-                              " then \\echo \"$f/\"; else \\echo \"$f\"; fi;"
+                              " then echo \"$f/\"; else echo \"$f\"; fi;"
                               " done")
                              (tramp-shell-quote-argument localname)
                              (tramp-get-ls-command v)
@@ -3525,6 +3548,41 @@ implementation will be used."
          (when coding-system-used
            (setq last-coding-system-used coding-system-used)))))))
 
+(defun tramp-bundle-read-file-names (vec files)
+  "Read file attributes of FILES and with one command fill the cache.
+FILES must be the local names only.  The cache attributes to be
+filled are described in `tramp-bundle-read-file-names'."
+  (when files
+    (tramp-maybe-send-script
+     vec
+     (format tramp-bundle-read-file-names
+            (tramp-get-file-exists-command vec)
+            (format "%s -r" (tramp-get-test-command vec))
+            (format "%s -d" (tramp-get-test-command vec)))
+     "tramp_bundle_read_file_names")
+
+    (dolist
+       (elt
+        (ignore-errors
+          ;; We cannot use `tramp-send-command-and-read', because
+          ;; this does not cooperate well with heredoc documents.
+          (tramp-send-command
+           vec
+           (format
+            "tramp_bundle_read_file_names <<'%s'\n%s\n%s\n"
+            tramp-end-of-heredoc
+            (mapconcat #'tramp-shell-quote-argument
+                       files
+                       "\n")
+            tramp-end-of-heredoc))
+          (with-current-buffer (tramp-get-connection-buffer vec)
+            ;; Read the expression.
+            (goto-char (point-min))
+            (read (current-buffer)))))
+
+      (tramp-set-file-property
+       vec (car elt) (cadr elt) (cadr (cdr elt))))))
+
 (defvar tramp-vc-registered-file-names nil
   "List used to collect file names, which are checked during `vc-registered'.")
 
@@ -3570,36 +3628,7 @@ implementation will be used."
              (tramp-message v 10 "\n%s" tramp-vc-registered-file-names)
 
              ;; Send just one command, in order to fill the cache.
-             (when tramp-vc-registered-file-names
-               (tramp-maybe-send-script
-                v
-                (format tramp-vc-registered-read-file-names
-                        (tramp-get-file-exists-command v)
-                        (format "%s -r" (tramp-get-test-command v)))
-                "tramp_vc_registered_read_file_names")
-
-               (dolist
-                   (elt
-                    (ignore-errors
-                      ;; We cannot use `tramp-send-command-and-read',
-                      ;; because this does not cooperate well with
-                      ;; heredoc documents.
-                      (tramp-send-command
-                       v
-                       (format
-                        "tramp_vc_registered_read_file_names <<'%s'\n%s\n%s\n"
-                        tramp-end-of-heredoc
-                        (mapconcat #'tramp-shell-quote-argument
-                                   tramp-vc-registered-file-names
-                                   "\n")
-                        tramp-end-of-heredoc))
-                      (with-current-buffer (tramp-get-connection-buffer v)
-                        ;; Read the expression.
-                        (goto-char (point-min))
-                        (read (current-buffer)))))
-
-                 (tramp-set-file-property
-                  v (car elt) (cadr elt) (cadr (cdr elt))))))
+             (tramp-bundle-read-file-names v tramp-vc-registered-file-names))
 
            ;; Second run.  Now all `file-exists-p' or `file-readable-p'
            ;; calls shall be answered from the file cache.  We unset
@@ -4254,6 +4283,8 @@ file exists and nonzero exit status otherwise."
        "`tramp-histfile-override' uses invalid file `%s'"
        tramp-histfile-override))
 
+    (tramp-flush-connection-property
+     (tramp-get-connection-process vec) "scripts")
     (tramp-set-connection-property
      (tramp-get-connection-process vec) "remote-shell" shell)))
 
@@ -4335,12 +4366,10 @@ process to set up.  VEC specifies the connection."
     (tramp-open-shell vec (tramp-get-method-parameter vec 'tramp-remote-shell))
     (tramp-message vec 5 "Setting up remote shell environment")
 
-    ;; Disable line editing.
-    (tramp-send-command vec "set +o vi +o emacs" t)
-
-    ;; Dump option settings in the traces.
-    (when (>= tramp-verbose 9)
-      (tramp-send-command vec "set -o" t))
+    ;; Disable line editing.  Dump option settings in the traces.
+    (tramp-send-command
+     vec
+     (if (>= tramp-verbose 9) "set +o vi +o emacs -o" "set +o vi +o emacs") t)
 
     ;; Disable echo expansion.
     (tramp-send-command
@@ -5554,22 +5583,16 @@ Nonexistent directories are removed from spec."
          (setq remote-path (delq 'tramp-own-remote-path remote-path)))
 
        ;; Remove double entries.
-       (setq elt1 remote-path)
-       (while (consp elt1)
-         (while (and (car elt1) (setq elt2 (member (car elt1) (cdr elt1))))
-           (setcar elt2 nil))
-         (setq elt1 (cdr elt1)))
+       (setq remote-path
+             (cl-remove-duplicates
+              remote-path :test #'string-equal :from-end t))
 
        ;; Remove non-existing directories.
-       (delq
-        nil
-        (mapcar
-         (lambda (x)
-           (and
-            (stringp x)
-            (file-directory-p (tramp-make-tramp-file-name vec x))
-            x))
-         remote-path))))))
+       (let ((remote-file-name-inhibit-cache nil))
+         (tramp-bundle-read-file-names vec remote-path)
+         (cl-remove-if
+          (lambda (x) (not (tramp-get-file-property vec x "file-directory-p")))
+          remote-path))))))
 
 (defun tramp-get-remote-locale (vec)
   "Determine remote locale, supporting UTF8 if possible."
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 60d40fef147..9c96a3f6851 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1176,7 +1176,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
     (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
+  (tramp-skeleton-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)
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 2bbe0945330..2ce2647b5ac 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -574,9 +574,9 @@ the result will be a local, non-Tramp, file name."
   (with-parsed-tramp-file-name (expand-file-name filename) nil
     (with-tramp-file-property v localname "file-writable-p"
       (if (file-exists-p filename)
+         ;; Examine `file-attributes' cache to see if request can be
+         ;; satisfied without remote operation.
          (if (tramp-file-property-p v localname "file-attributes")
-             ;; Examine `file-attributes' cache to see if request can
-             ;; be satisfied without remote operation.
              (tramp-check-cached-permissions v ?w)
            (tramp-sudoedit-send-command
             v "test" "-w" (file-name-unquote localname)))
@@ -596,7 +596,7 @@ the result will be a local, non-Tramp, file name."
 (defun tramp-sudoedit-handle-make-symbolic-link
     (target linkname &optional ok-if-already-exists)
   "Like `make-symbolic-link' for Tramp files."
-  (tramp-skeleton-handle-make-symbolic-link target linkname 
ok-if-already-exists
+  (tramp-skeleton-make-symbolic-link target linkname ok-if-already-exists
     (tramp-sudoedit-send-command
      v "ln" "-sf"
      (file-name-unquote target)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 76674e5207f..00b47f6bead 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3286,6 +3286,8 @@ BODY is the backend specific code."
        (when (tramp-connectable-p ,filename)
         (with-parsed-tramp-file-name (expand-file-name ,filename) nil
           (with-tramp-file-property v localname "file-exists-p"
+            ;; Examine `file-attributes' cache to see if request can
+            ;; be satisfied without remote operation.
             (if (tramp-file-property-p v localname "file-attributes")
                 (not
                  (null (tramp-get-file-property v localname 
"file-attributes")))
@@ -3356,7 +3358,7 @@ BODY is the backend specific code."
         ,@body
         nil))))
 
-(defmacro tramp-skeleton-handle-make-symbolic-link
+(defmacro tramp-skeleton-make-symbolic-link
   (target linkname &optional ok-if-already-exists &rest body)
   "Skeleton for `tramp-*-handle-make-symbolic-link'.
 BODY is the backend specific code.
@@ -3961,8 +3963,14 @@ Let-bind it when necessary.")
 
 (defun tramp-handle-file-symlink-p (filename)
   "Like `file-symlink-p' for Tramp files."
-  (let ((x (file-attribute-type (file-attributes filename))))
-    (and (stringp x) x)))
+  (with-parsed-tramp-file-name (expand-file-name filename) nil
+    ;; Some operations, like `file-truename', set the file property
+    ;; "file-symlink-marker".  We can use it as indicator, and avoid a
+    ;; possible call of `file-attributes'.
+    (when (or (tramp-get-file-property v localname "file-symlink-marker")
+             (not (tramp-file-property-p v localname "file-symlink-marker")))
+      (let ((x (file-attribute-type (file-attributes filename))))
+       (and (stringp x) x)))))
 
 (defun tramp-handle-file-truename (filename)
   "Like `file-truename' for Tramp files."