From: Michael Albinus <michael.albinus@gmx.de>
Date: Mon, 31 Jul 2023 17:40:11 +0000 (+0200)
Subject: Optimizations on Tramp symlink handling
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=bfb7c58ac5c322d6363e83f68afa88fc88ba2a0f;p=emacs.git

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

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