From aa6ee3302f81f2e1727d06f9b2a7e64d1390fdaa Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 10 Jan 2021 13:26:29 +0100 Subject: [PATCH] Rework parts of Tramp's insert-directory, bug#45691 * lisp/net/tramp-sh.el (tramp-sh-handle-insert-directory): Fix some unibyte/multibyte inconsistencies. (Bug#45691) * test/lisp/net/tramp-tests.el (tramp-test17-insert-directory-one-file): New test. --- lisp/net/tramp-sh.el | 153 +++++++++++++++++------------------ test/lisp/net/tramp-tests.el | 57 ++++++++++++- 2 files changed, 129 insertions(+), 81 deletions(-) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index b43b4485fec..72873157f08 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2601,7 +2601,7 @@ The method used must be an out-of-band method." (t nil))))))))) (defun tramp-sh-handle-insert-directory - (filename switches &optional wildcard full-directory-p) + (filename switches &optional wildcard full-directory-p) "Like `insert-directory' for Tramp files." (setq filename (expand-file-name filename)) (unless switches (setq switches "")) @@ -2636,66 +2636,65 @@ The method used must be an out-of-band method." v 4 "Inserting directory `ls %s %s', wildcard %s, fulldir %s" switches filename (if wildcard "yes" "no") (if full-directory-p "yes" "no")) - ;; If `full-directory-p', we just say `ls -l FILENAME'. - ;; Else we chdir to the parent directory, then say `ls -ld BASENAME'. + ;; If `full-directory-p', we just say `ls -l FILENAME'. Else we + ;; chdir to the parent directory, then say `ls -ld BASENAME'. (if full-directory-p (tramp-send-command - v - (format "%s %s %s 2>%s" - (tramp-get-ls-command v) - switches - (if wildcard - localname - (tramp-shell-quote-argument (concat localname "."))) - (tramp-get-remote-null-device v))) + v (format "%s %s %s 2>%s" + (tramp-get-ls-command v) + switches + (if wildcard + localname + (tramp-shell-quote-argument (concat localname "."))) + (tramp-get-remote-null-device v))) (tramp-barf-unless-okay - v - (format "cd %s" (tramp-shell-quote-argument - (tramp-run-real-handler - #'file-name-directory (list localname)))) + v (format "cd %s" (tramp-shell-quote-argument + (tramp-run-real-handler + #'file-name-directory (list localname)))) "Couldn't `cd %s'" (tramp-shell-quote-argument (tramp-run-real-handler #'file-name-directory (list localname)))) (tramp-send-command - v - (format "%s %s %s 2>%s" - (tramp-get-ls-command v) - switches - (if (or wildcard - (zerop (length - (tramp-run-real-handler - #'file-name-nondirectory (list localname))))) - "" - (tramp-shell-quote-argument - (tramp-run-real-handler - #'file-name-nondirectory (list localname)))) - (tramp-get-remote-null-device v)))) - - (save-restriction - (let ((beg (point)) - (emc enable-multibyte-characters)) - (narrow-to-region (point) (point)) - ;; We cannot use `insert-buffer-substring' because the Tramp - ;; buffer changes its contents before insertion due to calling - ;; `expand-file-name' and alike. - (insert - (with-current-buffer (tramp-get-buffer v) - (buffer-string))) - - ;; Check for "--dired" output. We must enable unibyte - ;; strings, because the "--dired" output counts in bytes. - (set-buffer-multibyte nil) + v (format "%s %s %s 2>%s" + (tramp-get-ls-command v) + switches + (if (or wildcard + (zerop (length + (tramp-run-real-handler + #'file-name-nondirectory (list localname))))) + "" + (tramp-shell-quote-argument + (tramp-run-real-handler + #'file-name-nondirectory (list localname)))) + (tramp-get-remote-null-device v)))) + + (let ((beg-marker (point-marker)) + (end-marker (point-marker)) + (emc enable-multibyte-characters)) + (set-marker-insertion-type beg-marker nil) + (set-marker-insertion-type end-marker t) + ;; We cannot use `insert-buffer-substring' because the Tramp + ;; buffer changes its contents before insertion due to calling + ;; `expand-file-name' and alike. + (insert (with-current-buffer (tramp-get-buffer v) (buffer-string))) + + ;; We must enable unibyte strings, because the "--dired" + ;; output counts in bytes. + (set-buffer-multibyte nil) + (save-restriction + (narrow-to-region beg-marker end-marker) + ;; Check for "--dired" output. (forward-line -2) (when (looking-at-p "//SUBDIRED//") (forward-line -1)) (when (looking-at "//DIRED//\\s-+") - (let ((databeg (match-end 0)) + (let ((beg (match-end 0)) (end (point-at-eol))) ;; Now read the numeric positions of file names. - (goto-char databeg) + (goto-char beg) (while (< (point) end) - (let ((start (+ beg (read (current-buffer)))) - (end (+ beg (read (current-buffer))))) + (let ((start (+ (point-min) (read (current-buffer)))) + (end (+ (point-min) (read (current-buffer))))) (if (memq (char-after end) '(?\n ?\ )) ;; End is followed by \n or by " -> ". (put-text-property start end 'dired-filename t)))))) @@ -2703,18 +2702,18 @@ The method used must be an out-of-band method." (goto-char (point-at-bol)) (while (looking-at "//") (forward-line 1) - (delete-region (match-beginning 0) (point))) - ;; Reset multibyte if needed. - (set-buffer-multibyte emc) + (delete-region (match-beginning 0) (point)))) + ;; Reset multibyte if needed. + (set-buffer-multibyte emc) + (save-restriction + (narrow-to-region beg-marker end-marker) ;; Some busyboxes are reluctant to discard colors. (unless (string-match-p "color" (tramp-get-connection-property v "ls" "")) - (save-excursion - (goto-char beg) - (while - (re-search-forward tramp-display-escape-sequence-regexp nil t) - (replace-match "")))) + (goto-char (point-min)) + (while (re-search-forward tramp-display-escape-sequence-regexp nil t) + (replace-match ""))) ;; Now decode what read if necessary. Stolen from `insert-directory'. (let ((coding (or coding-system-for-read @@ -2729,36 +2728,32 @@ The method used must be an out-of-band method." ;; If no coding system is specified or detection is ;; requested, detect the coding. (if (eq (coding-system-base coding) 'undecided) - (setq coding (detect-coding-region beg (point) t))) - (if (not (eq (coding-system-base coding) 'undecided)) - (save-restriction - (setq coding-no-eol - (coding-system-change-eol-conversion coding 'unix)) - (narrow-to-region beg (point)) - (goto-char (point-min)) - (while (not (eobp)) - (setq pos (point) - val (get-text-property (point) 'dired-filename)) - (goto-char (next-single-property-change - (point) 'dired-filename nil (point-max))) - ;; Force no eol conversion on a file name, so - ;; that CR is preserved. - (decode-coding-region pos (point) - (if val coding-no-eol coding)) - (if val - (put-text-property pos (point) - 'dired-filename t))))))) + (setq coding (detect-coding-region (point-min) (point) t))) + (unless (eq (coding-system-base coding) 'undecided) + (setq coding-no-eol + (coding-system-change-eol-conversion coding 'unix)) + (goto-char (point-min)) + (while (not (eobp)) + (setq pos (point) + val (get-text-property (point) 'dired-filename)) + (goto-char (next-single-property-change + (point) 'dired-filename nil (point-max))) + ;; Force no eol conversion on a file name, so that + ;; CR is preserved. + (decode-coding-region + pos (point) (if val coding-no-eol coding)) + (if val (put-text-property pos (point) 'dired-filename t)))))) ;; The inserted file could be from somewhere else. (when (and (not wildcard) (not full-directory-p)) (goto-char (point-max)) (when (file-symlink-p filename) - (goto-char (search-backward "->" beg 'noerror))) + (goto-char (search-backward "->" (point-min) 'noerror))) (search-backward (if (directory-name-p filename) "." (file-name-nondirectory filename)) - beg 'noerror) + (point-min) 'noerror) (replace-match (file-relative-name filename) t)) ;; Try to insert the amount of free space. @@ -2769,9 +2764,11 @@ The method used must be an out-of-band method." ;; Replace "total" with "total used", to avoid confusion. (replace-match "\\1 used in directory") (end-of-line) - (insert " available " available))) + (insert " available " available)))) - (goto-char (point-max))))))) + (prog1 (goto-char end-marker) + (set-marker beg-marker nil) + (set-marker end-marker nil)))))) ;; Canonicalization of file names. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index e1cb9939f29..3995006898a 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3067,9 +3067,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (regexp-opt (directory-files tmp-name1)) (length (directory-files tmp-name1))))))) - ;; Check error case. We do not check for the error type, - ;; because ls-lisp returns `file-error', and native Tramp - ;; returns `file-missing'. + ;; Check error case. (delete-directory tmp-name1 'recursive) (with-temp-buffer (should-error @@ -3188,6 +3186,59 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (ignore-errors (delete-directory tmp-name1 'recursive)) (ignore-errors (delete-directory tmp-name2 'recursive)))))) +;; The following test is inspired by Bug#45691. +(ert-deftest tramp-test17-insert-directory-one-file () + "Check `insert-directory' inside directory listing." + (skip-unless (tramp--test-enabled)) + + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) + (let* ((tmp-name1 + (expand-file-name (tramp--test-make-temp-name nil quoted))) + (tmp-name2 (expand-file-name "foo" tmp-name1)) + (tmp-name3 (expand-file-name "bar" tmp-name1)) + (dired-copy-preserve-time t) + (dired-recursive-copies 'top) + dired-copy-dereference + buffer) + (unwind-protect + (progn + (make-directory tmp-name1) + (write-region "foo" nil tmp-name2) + (should (file-directory-p tmp-name1)) + (should (file-exists-p tmp-name2)) + + ;; Check, that `insert-directory' works properly. + (with-current-buffer + (setq buffer (dired-noselect tmp-name1 "--dired -al")) + (read-only-mode -1) + (goto-char (point-min)) + (while (not (or (eobp) + (string-equal + (dired-get-filename 'localp 'no-error) + (file-name-nondirectory tmp-name2)))) + (forward-line 1)) + (should-not (eobp)) + (copy-file tmp-name2 tmp-name3) + (insert-directory + (file-name-nondirectory tmp-name3) "--dired -al -d") + ;; Point shall still be the recent file. + (should + (string-equal + (dired-get-filename 'localp 'no-error) + (file-name-nondirectory tmp-name2))) + (should-not (re-search-forward "dired" nil t)) + ;; The copied file has been inserted the line before. + (forward-line -1) + (should + (string-equal + (dired-get-filename 'localp 'no-error) + (file-name-nondirectory tmp-name3)))) + (kill-buffer buffer)) + + ;; Cleanup. + (ignore-errors (kill-buffer buffer)) + (ignore-errors (delete-directory tmp-name1 'recursive)))))) + ;; Method "smb" supports `make-symbolic-link' only if the remote host ;; has CIFS capabilities. tramp-adb.el, tramp-gvfs.el and ;; tramp-rclone.el do not support symbolic links at all. -- 2.39.5