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

Fix Tramp problem with loooongish file names

Browse source 
* lisp/net/tramp-sh.el (tramp-readlink-file-truename): New defconst.
(tramp-bundle-read-file-names): Use new %m and %q format specifiers.
(tramp-sh-handle-file-truename): Use `tramp-readlink-file-truename'.
(tramp-bundle-read-file-names, tramp-get-remote-readlink): Simplify.
(tramp-expand-script): Add format specifiers %m and %q for test
commands.  Addapt readlink call.
Reported by Stacey Marshall <stacey.marshall@gmail.com>.
This commit is contained in:
Michael Albinus 2025-04-04 14:29:00 +02:00
parent 9869aa1a10
commit 99d70ce6c2
1 changed files with 51 additions and 42 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -644,6 +644,14 @@ we have this shell function.
Format specifiers are replaced by `tramp-expand-script', percent Format specifiers are replaced by `tramp-expand-script', percent
characters need to be doubled.") characters need to be doubled.")
(defconst tramp-readlink-file-truename
"if %m -h \"$1\"; then echo t; else echo nil; fi
%r \"$1\""
"Shell script to produce output suitable for use with `file-truename'
on the remote file system.
Format specifiers are replaced by `tramp-expand-script', percent
characters need to be doubled.")
(defconst tramp-perl-file-truename (defconst tramp-perl-file-truename
"%p -e ' "%p -e '
use File::Spec; use File::Spec;
@ -1147,11 +1155,11 @@ characters need to be doubled.")
(defconst tramp-bundle-read-file-names (defconst tramp-bundle-read-file-names
"echo \"(\" "echo \"(\"
while read file; do while read file; do
quoted=`echo \"$file\" | sed -e \"s/\\\"/\\\\\\\\\\\\\\\\\\\"/\"` quoted=`echo \"$file\" | sed -e \"s/\\\"/\\\\\\\\\\\\\\\\\\\"/\"`
printf \"(%%b\" \"\\\"$quoted\\\"\" printf \"(%%b\" \"\\\"$quoted\\\"\"
if %s \"$file\"; then printf \" %%b\" t; else printf \" %%b\" nil; fi if %q \"$file\"; then printf \" %%b\" t; else printf \" %%b\" nil; fi
if %s \"$file\"; then printf \" %%b\" t; else printf \" %%b\" nil; fi if %m -r \"$file\"; then printf \" %%b\" t; else printf \" %%b\" nil; fi
if %s \"$file\"; then printf \" %%b)\n\" t; else printf \" %%b)\n\" nil; fi if %m -d \"$file\"; then printf \" %%b)\n\" t; else printf \" %%b)\n\" nil; fi
done done
echo \")\"" echo \")\""
"Script to check file attributes of a bundle of files. "Script to check file attributes of a bundle of files.
@ -1287,18 +1295,15 @@ Operations not mentioned here will be handled by the normal Emacs functions.")
(cond (cond
;; Use GNU readlink --canonicalize-missing where available. ;; Use GNU readlink --canonicalize-missing where available.
((tramp-get-remote-readlink v) ((tramp-get-remote-readlink v)
(tramp-maybe-send-script
v tramp-readlink-file-truename "tramp_readlink_file_truename")
(tramp-send-command-and-check (tramp-send-command-and-check
v (format v (format "tramp_readlink_file_truename %s"
(concat (tramp-shell-quote-argument localname)))
"(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) (with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min)) (goto-char (point-min))
(tramp-set-file-property v localname "file-symlink-marker" (read (current-buffer))) (tramp-set-file-property
v localname "file-symlink-marker" (read (current-buffer)))
;; We cannot call `read', the file name isn't quoted. ;; We cannot call `read', the file name isn't quoted.
(forward-line) (forward-line)
(buffer-substring (point) (line-end-position)))) (buffer-substring (point) (line-end-position))))
@ -1314,7 +1319,8 @@ Operations not mentioned here will be handled by the normal Emacs functions.")
(tramp-shell-quote-argument localname))) (tramp-shell-quote-argument localname)))
(with-current-buffer (tramp-get-connection-buffer v) (with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min)) (goto-char (point-min))
(tramp-set-file-property v localname "file-symlink-marker" (read (current-buffer))) (tramp-set-file-property
v localname "file-symlink-marker" (read (current-buffer)))
(read (current-buffer)))) (read (current-buffer))))
;; Do it yourself. ;; Do it yourself.
@ -3595,12 +3601,7 @@ FILES must be the local names only. The cache attributes to be
filled are described in `tramp-bundle-read-file-names'." filled are described in `tramp-bundle-read-file-names'."
(when files (when files
(tramp-maybe-send-script (tramp-maybe-send-script
vec vec tramp-bundle-read-file-names "tramp_bundle_read_file_names")
(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 (dolist
(elt (elt
@ -3986,14 +3987,15 @@ Fall back to normal file name handler if no Tramp handler exists."
(defun tramp-expand-script (vec script) (defun tramp-expand-script (vec script)
"Expand SCRIPT with remote files or commands. "Expand SCRIPT with remote files or commands.
\"%a\", \"%h\", \"%l\", \"%o\", \"%p\", \"%r\", \"%s\" and \"%y\" \"%a\", \"%h\", \"%l\", \"%m\", \"%o\", \"%p\", \"%q\", \"%r\", \"%s\"
format specifiers are replaced by the respective `awk', and \"%y\" format specifiers are replaced by the respective `awk',
`hexdump', `ls', `od', `perl', `readlink', `stat' and `python' `hexdump', `ls', `test', od', `perl', `test -e', `readlink', `stat' and
commands. \"%n\" is replaced by \"2>/dev/null\", and \"%t\" is `python' commands. \"%n\" is replaced by \"2>/dev/null\", and \"%t\" is
replaced by a temporary file name. If VEC is nil, the respective replaced by a temporary file name. If VEC is nil, the respective local
local commands are used. If there is a format specifier which commands are used. If there is a format specifier which cannot be
cannot be expanded, this function returns nil." expanded, this function returns nil."
(if (not (string-match-p (rx (| bol (not "%")) "%" (any "ahlnoprsty")) script)) (if (not (string-match-p
(rx (| bol (not "%")) "%" (any "ahlmnopqrsty")) script))
script script
(catch 'wont-work (catch 'wont-work
(let ((awk (when (string-match-p (rx (| bol (not "%")) "%a") script) (let ((awk (when (string-match-p (rx (| bol (not "%")) "%a") script)
@ -4016,6 +4018,12 @@ cannot be expanded, this function returns nil."
(or (tramp-get-ls-command vec) (or (tramp-get-ls-command vec)
(throw 'wont-work nil)) (throw 'wont-work nil))
(tramp-sh--quoting-style-options vec)))) (tramp-sh--quoting-style-options vec))))
(test (when (string-match-p (rx (| bol (not "%")) "%m") script)
(or (tramp-get-test-command vec)
(throw 'wont-work nil))))
(test-e (when (string-match-p (rx (| bol (not "%")) "%q") script)
(or (tramp-get-file-exists-command vec)
(throw 'wont-work nil))))
(od (when (string-match-p (rx (| bol (not "%")) "%o") script) (od (when (string-match-p (rx (| bol (not "%")) "%o") script)
(or (if vec (tramp-get-remote-od vec) (executable-find "od")) (or (if vec (tramp-get-remote-od vec) (executable-find "od"))
(throw 'wont-work nil)))) (throw 'wont-work nil))))
@ -4031,11 +4039,13 @@ cannot be expanded, this function returns nil."
(executable-find "python")) (executable-find "python"))
(throw 'wont-work nil)))) (throw 'wont-work nil))))
(readlink (when (string-match-p (rx (| bol (not "%")) "%r") script) (readlink (when (string-match-p (rx (| bol (not "%")) "%r") script)
(or (format "%s %s"
(if vec (or
(tramp-get-remote-readlink vec) (if vec
(executable-find "readlink")) (tramp-get-remote-readlink vec)
(throw 'wont-work nil)))) (executable-find "readlink"))
(throw 'wont-work nil))
"--canonicalize-missing")))
(stat (when (string-match-p (rx (| bol (not "%")) "%s") script) (stat (when (string-match-p (rx (| bol (not "%")) "%s") script)
(or (or
(if vec (if vec
@ -4050,8 +4060,8 @@ cannot be expanded, this function returns nil."
(format-spec (format-spec
script script
(format-spec-make (format-spec-make
?a awk ?h hdmp ?l ls ?n dev ?o od ?p perl ?a awk ?h hdmp ?l ls ?m test ?n dev ?o od ?p perl
?r readlink ?s stat ?t tmp ?y python)))))) ?q test-e ?r readlink ?s stat ?t tmp ?y python))))))
(defun tramp-maybe-send-script (vec script name) (defun tramp-maybe-send-script (vec script name)
"Define in remote shell function NAME implemented as SCRIPT. "Define in remote shell function NAME implemented as SCRIPT.
@ -5850,12 +5860,11 @@ Nonexistent directories are removed from spec."
"Determine remote `readlink' command." "Determine remote `readlink' command."
(with-tramp-connection-property vec "readlink" (with-tramp-connection-property vec "readlink"
(tramp-message vec 5 "Finding a suitable `readlink' command") (tramp-message vec 5 "Finding a suitable `readlink' command")
(let ((result (tramp-find-executable (when-let* ((result (tramp-find-executable
vec "readlink" (tramp-get-remote-path vec)))) vec "readlink" (tramp-get-remote-path vec)))
(when (and result ((tramp-send-command-and-check
(tramp-send-command-and-check vec (format "%s --canonicalize-missing /" result))))
vec (format "%s --canonicalize-missing /" result))) result)))
result))))
(defun tramp-get-remote-touch (vec) (defun tramp-get-remote-touch (vec)
"Determine remote `touch' command." "Determine remote `touch' command."