bug#39452: [PATCH] vc-git-state fails for filenames with wildcards

[Wolfgang Scherer <Wolfgang.Scherer@gmx.de>]

[-- Attachment #1: Type: text/plain, Size: 1520 bytes --]

Am 07.02.20 um 18:25 schrieb Wolfgang Scherer:
> Hi Dmitry,
>
> Am 07.02.20 um 00:00 schrieb Dmitry Gutov:
>> On 06.02.2020 16:59, Wolfgang Scherer wrote:
>>> When a filename contains shell wildcard characters matching one or more files, e.g. `test[56].xx` matching both `test5.xx` and `test6.xx`:
>>> The command `vc-git-state` does not work correctly.
>>>
>>> The attched patch fixes this:
>>>
>>> -        (status (apply #'vc-git--run-command-string file args)))
>>> +        (status (apply #'vc-git--run-command-string (shell-quote-argument file) args)))
>>>
>> Thanks for the report and the patch.
>>
>> I wonder how many other backends commands are broken for files like that: we basically never shell-quote file names.

After some research, it seems that adding a pathspec magic to commands that support this feature is the best solution.

Here is a patch that applies vc-git--literal-pathspec, vc-git--literal-pathspecs to some git commands in vc-git.el. I have tested all augmented commands in the shell and some in emacs.

(defun vc-git--literal-pathspec-inner (pathspec)
  "Prepend :(literal) path magic to PATHSPEC."
  (concat ":(literal)" pathspec))

(defun vc-git--literal-pathspec (pathspec)
  "Prepend :(literal) path magic to PATHSPEC."
  (and pathspec (vc-git--literal-pathspec-inner pathspec)))

(defun vc-git--literal-pathspecs (pathspecs)
  "Prepend :(literal) path magic to PATHSPECS."
  (mapcar #'vc-git--literal-pathspec-inner pathspecs))
\x01


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-vc-git-state-fails-for-filenames-with-wildcards.patch --]
[-- Type: text/x-patch; name="0001-vc-git-state-fails-for-filenames-with-wildcards.patch", Size: 11112 bytes --]

From eab5ef41ff06471d3cf9387d96a09c70e586b0e6 Mon Sep 17 00:00:00 2001
From: Wolfgang Scherer <wolfgang.scherer@gmx.de>
Date: Fri, 7 Feb 2020 23:24:27 +0100
Subject: [PATCH] vc-git-state fails for filenames with wildcards

* lisp/vc/vc-git.el: (vc-git--literal-pathspec-inner),
(vc-git--literal-pathspec), (vc-git--literal-pathspecs) new functions
to add ":(literal)" pathspec magic.

(vc-git-registered), (vc-git-state), (vc-git-dir-status-goto-stage),
(vc-git-register), (vc-git-unregister), (vc-git-checkin),
(vc-git-find-revision), (vc-git-checkout), (vc-git-revert),
(vc-git-conflicted-files), (vc-git-print-log), (vc-git-diff),
(vc-git-previous-revision), (vc-git-next-revision),
(vc-git-delete-file), (vc-git-rename-file) functions
vc-git--literal-pathspec, vc-git--literal-pathspecs applied.
---
 lisp/vc/vc-git.el | 65 ++++++++++++++++++++++++++++++++++---------------------
 1 file changed, 40 insertions(+), 25 deletions(-)

diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 2caa287..1a38cef 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -217,6 +217,21 @@ toggle display of the entire list."

 ;;; BACKEND PROPERTIES

+(defun vc-git--literal-pathspec-inner (pathspec)
+  "Prepend :(literal) path magic to PATHSPEC."
+  (concat ":(literal)" pathspec))
+;; (vc-git--literal-pathspec-inner "test[56].xx")
+
+(defun vc-git--literal-pathspec (pathspec)
+  "Prepend :(literal) path magic to PATHSPEC."
+  (and pathspec (vc-git--literal-pathspec-inner pathspec)))
+;; (vc-git--literal-pathspec nil)
+;; (vc-git--literal-pathspec "test[56].xx")
+
+(defun vc-git--literal-pathspecs (pathspecs)
+  "Prepend :(literal) path magic to PATHSPECS."
+  (mapcar #'vc-git--literal-pathspec-inner pathspecs))
+
 (defun vc-git-revision-granularity () 'repository)
 (defun vc-git-checkout-model (_files) 'implicit)
 (defun vc-git-update-on-retrieve-tag () nil)
@@ -243,12 +258,12 @@ toggle display of the entire list."
                (name (file-relative-name file dir))
                (str (ignore-errors
                       (cd dir)
-                      (vc-git--out-ok "ls-files" "-c" "-z" "--" name)
+                      (vc-git--out-ok "ls-files" "-c" "-z" "--" (vc-git--literal-pathspec name))
                       ;; If result is empty, use ls-tree to check for deleted
                       ;; file.
                       (when (eq (point-min) (point-max))
                         (vc-git--out-ok "ls-tree" "--name-only" "-z" "HEAD"
-                                        "--" name))
+                                        "--" (vc-git--literal-pathspec name)))
                       (buffer-string))))
           (and str
                (> (length str) (length name))
@@ -330,7 +345,7 @@ in the order given by `git status'."
             ,@(when (version<= "1.7.6.3" (vc-git--program-version))
                 '("--ignored"))
             "--"))
-        (status (apply #'vc-git--run-command-string file args)))
+        (status (apply #'vc-git--run-command-string (vc-git--literal-pathspec file) args)))
     (if (null status)
         ;; If status is nil, there was an error calling git, likely because
         ;; the file is not in a git repo.
@@ -606,28 +621,28 @@ or an empty string if none."
     (pcase (vc-git-dir-status-state->stage git-state)
       ('update-index
        (if files
-           (vc-git-command (current-buffer) 'async files "add" "--refresh" "--")
+           (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files) "add" "--refresh" "--")
          (vc-git-command (current-buffer) 'async nil
                          "update-index" "--refresh")))
       ('ls-files-added
-       (vc-git-command (current-buffer) 'async files
+       (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files)
                        "ls-files" "-z" "-c" "-s" "--"))
       ('ls-files-up-to-date
-       (vc-git-command (current-buffer) 'async files
+       (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files)
                        "ls-files" "-z" "-c" "-s" "--"))
       ('ls-files-conflict
-       (vc-git-command (current-buffer) 'async files
+       (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files)
                        "ls-files" "-z" "-u" "--"))
       ('ls-files-unknown
-       (vc-git-command (current-buffer) 'async files
+       (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files)
                        "ls-files" "-z" "-o" "--exclude-standard" "--"))
       ('ls-files-ignored
-       (vc-git-command (current-buffer) 'async files
+       (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files)
                        "ls-files" "-z" "-o" "-i" "--directory"
                        "--no-empty-directory" "--exclude-standard" "--"))
       ;; --relative added in Git 1.5.5.
       ('diff-index
-       (vc-git-command (current-buffer) 'async files
+       (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files)
                        "diff-index" "--relative" "-z" "-M" "HEAD" "--")))
     (vc-run-delayed
       (vc-git-after-dir-status-stage git-state))))
@@ -861,12 +876,12 @@ The car of the list is the current branch."
     (when flist
       (vc-git-command nil 0 flist "update-index" "--add" "--"))
     (when dlist
-      (vc-git-command nil 0 dlist "add"))))
+      (vc-git-command nil 0 (vc-git--literal-pathspecs dlist) "add"))))

 (defalias 'vc-git-responsible-p 'vc-git-root)

 (defun vc-git-unregister (file)
-  (vc-git-command nil 0 file "rm" "-f" "--cached" "--"))
+  (vc-git-command nil 0 (vc-git--literal-pathspec file) "rm" "-f" "--cached" "--"))

 (declare-function log-edit-mode "log-edit" ())
 (declare-function log-edit-toggle-header "log-edit" (header value))
@@ -933,7 +948,7 @@ It is based on `log-edit-mode', and has Git-specific extensions.")
                (lambda (value) (when (equal value "yes") (list argument)))))
       ;; When operating on the whole tree, better pass "-a" than ".", since "."
       ;; fails when we're committing a merge.
-      (apply 'vc-git-command nil 0 (if only files)
+      (apply 'vc-git-command nil 0 (if only (vc-git--literal-pathspecs files))
              (nconc (if msg-file (list "commit" "-F"
                                        (file-local-name msg-file))
                       (list "commit" "-m"))
@@ -960,7 +975,7 @@ It is based on `log-edit-mode', and has Git-specific extensions.")
 	 (coding-system-for-write 'binary)
 	 (fullname
 	  (let ((fn (vc-git--run-command-string
-		     file "ls-files" "-z" "--full-name" "--")))
+		     (vc-git--literal-pathspec file) "ls-files" "-z" "--full-name" "--")))
 	    ;; ls-files does not return anything when looking for a
 	    ;; revision of a file that has been renamed or removed.
 	    (if (string= fn "")
@@ -977,14 +992,14 @@ It is based on `log-edit-mode', and has Git-specific extensions.")
 		    (vc-git-root file)))

 (defun vc-git-checkout (file &optional rev)
-  (vc-git-command nil 0 file "checkout" (or rev "HEAD")))
+  (vc-git-command nil 0 (vc-git--literal-pathspec file) "checkout" (or rev "HEAD")))

 (defun vc-git-revert (file &optional contents-done)
   "Revert FILE to the version stored in the git repository."
   (if contents-done
       (vc-git-command nil 0 file "update-index" "--")
-    (vc-git-command nil 0 file "reset" "-q" "--")
-    (vc-git-command nil nil file "checkout" "-q" "--")))
+    (vc-git-command nil 0 (vc-git--literal-pathspec file) "reset" "-q" "--")
+    (vc-git-command nil nil (vc-git--literal-pathspec file) "checkout" "-q" "--")))

 (defvar vc-git-error-regexp-alist
   '(("^ \\(.+\\)\\> *|" 1 nil nil 0))
@@ -1068,7 +1083,7 @@ This prompts for a branch to merge from."
 (defun vc-git-conflicted-files (directory)
   "Return the list of files with conflicts in DIRECTORY."
   (let* ((status
-          (vc-git--run-command-string directory "status" "--porcelain" "--"))
+          (vc-git--run-command-string (vc-git--literal-pathspec directory) "status" "--porcelain" "--"))
          (lines (when status (split-string status "\n" 'omit-nulls)))
          files)
     (dolist (line lines files)
@@ -1140,7 +1155,7 @@ If LIMIT is a revision string, use it as an end-revision."
     (let ((inhibit-read-only t))
       (with-current-buffer buffer
 	(apply 'vc-git-command buffer
-	       'async files
+	       'async (vc-git--literal-pathspecs files)
 	       (append
 		'("log" "--no-color")
                 (when (and vc-git-print-log-follow
@@ -1392,7 +1407,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
     (if vc-git-diff-switches
         (apply #'vc-git-command (or buffer "*vc-diff*")
 	       1 ; bug#21969
-	       files
+	       (vc-git--literal-pathspecs files)
                command
                "--exit-code"
                (append (vc-switches 'git 'diff)
@@ -1475,7 +1490,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
       (let* ((fname (file-relative-name file))
              (prev-rev (with-temp-buffer
                          (and
-                          (vc-git--out-ok "rev-list" "-2" rev "--" fname)
+                          (vc-git--out-ok "rev-list" "-2" rev "--" (vc-git--literal-pathspec fname))
                           (goto-char (point-max))
                           (bolp)
                           (zerop (forward-line -1))
@@ -1503,7 +1518,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
          (current-rev
           (with-temp-buffer
             (and
-             (vc-git--out-ok "rev-list" "-1" rev "--" file)
+             (vc-git--out-ok "rev-list" "-1" rev "--" (vc-git--literal-pathspec file))
              (goto-char (point-max))
              (bolp)
              (zerop (forward-line -1))
@@ -1515,7 +1530,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
           (and current-rev
                (with-temp-buffer
                  (and
-                  (vc-git--out-ok "rev-list" "HEAD" "--" file)
+                  (vc-git--out-ok "rev-list" "HEAD" "--" (vc-git--literal-pathspec file))
                   (goto-char (point-min))
                   (search-forward current-rev nil t)
                   (zerop (forward-line -1))
@@ -1525,10 +1540,10 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
     (or (vc-git-symbolic-commit next-rev) next-rev)))

 (defun vc-git-delete-file (file)
-  (vc-git-command nil 0 file "rm" "-f" "--"))
+  (vc-git-command nil 0 (vc-git--literal-pathspec file) "rm" "-f" "--"))

 (defun vc-git-rename-file (old new)
-  (vc-git-command nil 0 (list old new) "mv" "-f" "--"))
+  (vc-git-command nil 0 (vc-git--literal-pathspecs (list old new)) "mv" "-f" "--"))

 (defvar vc-git-extra-menu-map
   (let ((map (make-sparse-keymap)))
--
2.7.4