Commit 0e574ea3 authored by Michael Albinus's avatar Michael Albinus

Fix minor Tramp problems found on BSD

* lisp/net/tramp-sh.el (tramp-perl-file-truename): Do not append
trailing slash.  Quote apostrophes.
(tramp-sh-handle-file-truename): Do not append trailing slash in
the "ls" case.
(tramp-get-ls-command-with-w-option): New defun.
(tramp-do-file-attributes-with-ls)
(tramp-do-directory-files-and-attributes-with-stat): Use it.

* test/automated/tramp-tests.el
(tramp-test31-special-characters-with-perl)
(tramp-test31-special-characters-with-ls)
(tramp-test32-utf8-with-perl, tramp-test32-utf8-with-ls):
Suppress also readlink.
parent cca5629f
...@@ -621,10 +621,7 @@ if (!$result) { ...@@ -621,10 +621,7 @@ if (!$result) {
$result = File::Spec->catpath($vol, File::Spec->catdir(@dirs), \"\"); $result = File::Spec->catpath($vol, File::Spec->catdir(@dirs), \"\");
} }
if ($ARGV[0] =~ /\\/$/) { $result =~ s/\"/\\\\\"/g;
$result = $result . \"/\";
}
print \"\\\"$result\\\"\\n\"; print \"\\\"$result\\\"\\n\";
' \"$1\" 2>/dev/null" ' \"$1\" 2>/dev/null"
"Perl script to produce output suitable for use with `file-truename' "Perl script to produce output suitable for use with `file-truename'
...@@ -1143,20 +1140,17 @@ target of the symlink differ." ...@@ -1143,20 +1140,17 @@ target of the symlink differ."
;; Do it yourself. We bind `directory-sep-char' here for ;; Do it yourself. We bind `directory-sep-char' here for
;; XEmacs on Windows, which would otherwise use backslash. ;; XEmacs on Windows, which would otherwise use backslash.
(t (let* ((directory-sep-char ?/) (t (let ((directory-sep-char ?/)
(steps (tramp-compat-split-string localname "/")) (steps (tramp-compat-split-string localname "/"))
(localnamedir (tramp-run-real-handler (thisstep nil)
'file-name-as-directory (list localname))) (numchase 0)
(is-dir (string= localname localnamedir)) ;; Don't make the following value larger than
(thisstep nil) ;; necessary. People expect an error message in a
(numchase 0) ;; timely fashion when something is wrong;
;; Don't make the following value larger than ;; otherwise they might think that Emacs is hung.
;; necessary. People expect an error message in ;; Of course, correctness has to come first.
;; a timely fashion when something is wrong; (numchase-limit 20)
;; otherwise they might think that Emacs is hung. symlink-target)
;; Of course, correctness has to come first.
(numchase-limit 20)
symlink-target)
(while (and steps (< numchase numchase-limit)) (while (and steps (< numchase numchase-limit))
(setq thisstep (pop steps)) (setq thisstep (pop steps))
(tramp-message (tramp-message
...@@ -1212,10 +1206,8 @@ target of the symlink differ." ...@@ -1212,10 +1206,8 @@ target of the symlink differ."
(if result (if result
(mapconcat 'identity (cons "" result) "/") (mapconcat 'identity (cons "" result) "/")
"/")) "/"))
(when (and is-dir (when (string= "" result)
(or (string= "" result) (setq result "/")))))
(not (string= (substring result -1) "/"))))
(setq result (concat result "/"))))))
(tramp-message v 4 "True name of `%s' is `%s'" localname result) (tramp-message v 4 "True name of `%s' is `%s'" localname result)
result)))) result))))
...@@ -1278,8 +1270,12 @@ target of the symlink differ." ...@@ -1278,8 +1270,12 @@ target of the symlink differ."
(tramp-get-ls-command vec) (tramp-get-ls-command vec)
;; On systems which have no quoting style, file names ;; On systems which have no quoting style, file names
;; with special characters could fail. ;; with special characters could fail.
(if (tramp-get-ls-command-with-quoting-style vec) (cond
"--quoting-style=c" "") ((tramp-get-ls-command-with-quoting-style vec)
"--quoting-style=c")
((tramp-get-ls-command-with-w-option vec)
"-w")
(t ""))
(if (eq id-format 'integer) "-ildn" "-ild") (if (eq id-format 'integer) "-ildn" "-ild")
(tramp-shell-quote-argument localname))) (tramp-shell-quote-argument localname)))
;; Parse `ls -l' output ... ;; Parse `ls -l' output ...
...@@ -1837,10 +1833,14 @@ be non-negative integers." ...@@ -1837,10 +1833,14 @@ be non-negative integers."
"-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\"") "-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\"")
(tramp-shell-quote-argument localname) (tramp-shell-quote-argument localname)
(tramp-get-ls-command vec) (tramp-get-ls-command vec)
;; On systems which have no quoting style, file names with ;; On systems which have no quoting style, file names with special
;; special characters could fail. ;; characters could fail.
(if (tramp-get-ls-command-with-quoting-style vec) (cond
"--quoting-style=shell" "") ((tramp-get-ls-command-with-quoting-style vec)
"--quoting-style=shell")
((tramp-get-ls-command-with-w-option vec)
"-w")
(t ""))
(tramp-get-remote-stat vec) (tramp-get-remote-stat vec)
tramp-stat-marker tramp-stat-marker tramp-stat-marker tramp-stat-marker
tramp-stat-marker tramp-stat-marker tramp-stat-marker tramp-stat-marker
...@@ -5417,6 +5417,14 @@ Return ATTR." ...@@ -5417,6 +5417,14 @@ Return ATTR."
vec (format "%s --quoting-style=shell -al /dev/null" vec (format "%s --quoting-style=shell -al /dev/null"
(tramp-get-ls-command vec)))))) (tramp-get-ls-command vec))))))
(defun tramp-get-ls-command-with-w-option (vec)
(save-match-data
(with-tramp-connection-property vec "ls-w-option"
(tramp-message vec 5 "Checking, whether `ls -w' works")
;; Option "-w" is available on BSD systems.
(tramp-send-command-and-check
vec (format "%s -alw /dev/null" (tramp-get-ls-command vec))))))
(defun tramp-get-test-command (vec) (defun tramp-get-test-command (vec)
(with-tramp-connection-property vec "test" (with-tramp-connection-property vec "test"
(tramp-message vec 5 "Finding a suitable `test' command") (tramp-message vec 5 "Finding a suitable `test' command")
......
...@@ -1987,7 +1987,10 @@ Use the `perl' command." ...@@ -1987,7 +1987,10 @@ Use the `perl' command."
(let ((tramp-connection-properties (let ((tramp-connection-properties
(append (append
`((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
"stat" nil)) "stat" nil)
;; See `tramp-sh-handle-file-truename'.
(,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
"readlink" nil))
tramp-connection-properties))) tramp-connection-properties)))
(tramp--test-special-characters))) (tramp--test-special-characters)))
...@@ -2005,7 +2008,10 @@ Use the `ls' command." ...@@ -2005,7 +2008,10 @@ Use the `ls' command."
`((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
"perl" nil) "perl" nil)
(,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
"stat" nil)) "stat" nil)
;; See `tramp-sh-handle-file-truename'.
(,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
"readlink" nil))
tramp-connection-properties))) tramp-connection-properties)))
(tramp--test-special-characters))) (tramp--test-special-characters)))
...@@ -2059,7 +2065,10 @@ Use the `perl' command." ...@@ -2059,7 +2065,10 @@ Use the `perl' command."
(let ((tramp-connection-properties (let ((tramp-connection-properties
(append (append
`((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
"stat" nil)) "stat" nil)
;; See `tramp-sh-handle-file-truename'.
(,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
"readlink" nil))
tramp-connection-properties))) tramp-connection-properties)))
(tramp--test-utf8))) (tramp--test-utf8)))
...@@ -2077,7 +2086,10 @@ Use the `ls' command." ...@@ -2077,7 +2086,10 @@ Use the `ls' command."
`((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
"perl" nil) "perl" nil)
(,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
"stat" nil)) "stat" nil)
;; See `tramp-sh-handle-file-truename'.
(,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
"readlink" nil))
tramp-connection-properties))) tramp-connection-properties)))
(tramp--test-utf8))) (tramp--test-utf8)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment