bug#62693: 28.2; VC: CVS: Fix lost file reporting and enable reverting it

[Olivier Certner <ocert.dev@free.fr>]

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

Hi,

Thanks for looking at this.

> - Could you explain what kind of files are not listed and when? I'm 
> guessing this has to do with the file name? I've tried to reproduce the 
> problem with a file name that contained a space, and couldn't see it.

It's not that files are not listed, they are so always. As said, the problem 
is their name. For example, if I remove an INSTALL file in a repository, 
`INSTALL' is the name listed in a VC dir buffer, *quotes included*. Then, no 
VC operation can work because there is indeed no file by this name (with 
quotes, both in the filesystem or known by CVS).

> - Could you give an example of the repository CVS root which is 
> recognized by the current code incorrectly?

Just run (vc-cvs-parse-root "/your/local/path/to/some/CVS/repo") and you'll 
see...

I've found more occurences of problems with this function, so my initial fix 
is not enough. I went ahead and rewrote it completely. So please forget about 
the original first patch, and consider it replaced by the attached one. The 
commit message there explains how you can reproduce the bugs I found and shows 
that the new version fixes them.

Regards.

-- 
Olivier Certner

[-- Attachment #2: 0001-VC-CVS-Fix-Root-file-parsing.patch --]
[-- Type: text/x-patch, Size: 11896 bytes --]

From 8d5fc570d135c118af820db1e54a56aa7123e554 Mon Sep 17 00:00:00 2001
From: Olivier Certner <olce.emacs@certner.fr>
Date: Thu, 6 Apr 2023 10:16:33 +0200
Subject: [PATCH] VC: CVS: Fix "Root" file parsing

The new "Root" file parsing has been based on CVS' documentation,
which gives the following format for *remote* repositories:
[:method:][[user][:password]@]hostname[:[port]]/path/to/repository
and for local ones:
:local:/path
or
:local:c:/path
or alternatively ':local:' replaced by ':fork:', or ':local:' omitted
when the path starts with a slash.

[The actual parsing code in CVS is actually a bit more restrictive.
See 'root.c'.]

The end result is that the following test expression:
  (mapcar (lambda (p)
            (list p (vc-cvs-parse-root p)))
          '("/home/joe/repo"
            ":local:c:/users/joe/repo"
            "host/home/serv/repo"
            ":pserver:host/home/serv/repo"
            ":pserver:host:/home/serv/repo"
            "usr@host/home/serv/repo"
            "usr@host:/home/serv/repo"
            ":pserver:usr:passwd@host:/home/serv/repo"
            ":pserver:usr:passwd@host/home/serv/repo"
            ":pserver:usr:passwd@host:28/home/serv/repo"
            "usr:passwd@host:/home/serv/repo"
            "usr:passwd@host/home/serv/repo"
            "usr:passwd@host:28/home/serv/repo"))

gives the expected results:
  (("/home/joe/repo"
    ("local" nil nil "/home/joe/repo"))
   (":local:c:/users/joe/repo"
    ("local" nil nil "c:/users/joe/repo"))
   ("host/home/serv/repo"
    ("ext" nil "host" "/home/serv/repo"))
   (":pserver:host/home/serv/repo"
    ("pserver" nil "host" "/home/serv/repo"))
   (":pserver:host:/home/serv/repo"
    ("pserver" nil "host" "/home/serv/repo"))
   ("usr@host/home/serv/repo"
    ("ext" "usr" "host" "/home/serv/repo"))
   ("usr@host:/home/serv/repo"
    ("ext" "usr" "host" "/home/serv/repo"))
   (":pserver:usr:passwd@host:/home/serv/repo"
    ("pserver" "usr" "host" "/home/serv/repo"))
   (":pserver:usr:passwd@host/home/serv/repo"
    ("pserver" "usr" "host" "/home/serv/repo"))
   (":pserver:usr:passwd@host:28/home/serv/repo"
    ("pserver" "usr" "host" "/home/serv/repo"))
   ("usr:passwd@host:/home/serv/repo"
    ("ext" "usr" "host" "/home/serv/repo"))
   ("usr:passwd@host/home/serv/repo"
    ("ext" "usr" "host" "/home/serv/repo"))
   ("usr:passwd@host:28/home/serv/repo"
    ("ext" "usr" "host" "/home/serv/repo")))

instead of the current and erroneous:
  (("/home/joe/repo"
    ("ext" nil "home" "/joe/repo"))
   (":local:c:/users/joe/repo"
    ("local" nil nil "c:/users/joe/repo"))
   ("host/home/serv/repo"
    ("ext" nil "host" "/home/serv/repo"))
   (":pserver:host/home/serv/repo"
    ("pserver" nil "host" "/home/serv/repo"))
   (":pserver:host:/home/serv/repo"
    ("pserver" nil "host" "/home/serv/repo"))
   ("usr@host/home/serv/repo"
    ("ext" "usr" "host" "/home/serv/repo"))
   ("usr@host:/home/serv/repo"
    ("ext" "usr" "host" "/home/serv/repo"))
   (":pserver:usr:passwd@host:/home/serv/repo"
    ("pserver" nil "usr" "passwd@host"))
   (":pserver:usr:passwd@host/home/serv/repo"
    ("pserver" nil "usr" "passwd@host/home/serv/repo"))
   (":pserver:usr:passwd@host:28/home/serv/repo"
    ("pserver" nil "usr" "passwd@host"))
   ("usr:passwd@host:/home/serv/repo"
    ("passwd@host" nil "home" "/serv/repo"))
   ("usr:passwd@host/home/serv/repo"
    ("ext" nil "usr" "passwd@host/home/serv/repo"))
   ("usr:passwd@host:28/home/serv/repo"
    ("passwd@host" nil "28" "/home/serv/repo")))

* lisp/vc/vc-cvs.el (vc-cvs-parse-root): Rewrite.

(vc-cvs-parse-uhp): Remove this standalone function formerly used only
by `vc-cvs-parse-root' and which doesn't allow correct parsing anyway.
---
 lisp/vc/vc-cvs.el | 177 +++++++++++++++++++++++++++++++---------------
 1 file changed, 121 insertions(+), 56 deletions(-)

diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index 1a47722867f..71e86a0076c 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -26,6 +26,7 @@
 
 (require 'vc-rcs)
 (eval-when-compile (require 'vc))
+(eval-when-compile (require 'cl-lib))
 
 (declare-function vc-checkout "vc" (file &optional rev))
 (declare-function vc-expand-dirs "vc" (file-or-dir-list backend))
@@ -825,69 +826,133 @@ vc-cvs-repository-hostname
 		(buffer-substring (point)
 				  (line-end-position))))))))
 
-(defun vc-cvs-parse-uhp (path)
-  "Parse user@host/path into (user@host /path)."
-  (if (string-match "\\([^/]+\\)\\(/.*\\)" path)
-      (list (match-string 1 path) (match-string 2 path))
-      (list nil path)))
-
-(defun vc-cvs-parse-root (root)
+(cl-defun vc-cvs-parse-root (root)
   "Split CVS ROOT specification string into a list of fields.
+
 A CVS root specification of the form
-  [:METHOD:][[USER@]HOSTNAME]:?/path/to/repository
+  [:METHOD:][[[USER][:PASSWORD]@]HOSTNAME][:[PORT]]/path/to/repository
 is converted to a normalized record with the following structure:
-  \(METHOD USER HOSTNAME CVS-ROOT).
+  \(METHOD USER HOSTNAME PATH).
+
 The default METHOD for a CVS root of the form
   /path/to/repository
-is `local'.
+is \"local\".
 The default METHOD for a CVS root of the form
   [USER@]HOSTNAME:/path/to/repository
-is `ext'.
-For an empty string, nil is returned (invalid CVS root)."
-  ;; Split CVS root into colon separated fields (0-4).
-  ;; The `x:' makes sure, that leading colons are not lost;
-  ;; `HOST:/PATH' is then different from `:METHOD:/PATH'.
-  (let* ((root-list (cdr (split-string (concat "x:" root) ":")))
-         (len (length root-list))
-         ;; All syntactic varieties will get a proper METHOD.
-         (root-list
-          (cond
-           ((= len 0)
-            ;; Invalid CVS root
-            nil)
-           ((= len 1)
-            (let ((uhp (vc-cvs-parse-uhp (car root-list))))
-              (cons (if (car uhp) "ext" "local") uhp)))
-           ((= len 2)
-            ;; [USER@]HOST:PATH => method `ext'
-            (and (not (equal (car root-list) ""))
-                 (cons "ext" root-list)))
-           ((= len 3)
-            ;; :METHOD:PATH or :METHOD:USER@HOSTNAME/PATH
-            (cons (cadr root-list)
-                  (vc-cvs-parse-uhp (nth 2 root-list))))
-           (t
-            ;; :METHOD:[USER@]HOST:PATH
-            (cdr root-list)))))
-    (if root-list
-        (let ((method (car root-list))
-              (uhost (or (cadr root-list) ""))
-              (root (nth 2 root-list))
-              user host)
-          ;; Split USER@HOST
-          (if (string-match "\\(.*\\)@\\(.*\\)" uhost)
-              (setq user (match-string 1 uhost)
-                    host (match-string 2 uhost))
-            (setq host uhost))
-          ;; Remove empty HOST
-          (and (equal host "")
-               (setq host nil))
-          ;; Fix windows style CVS root `:local:C:\\project\\cvs\\some\\dir'
-          (and host
-               (equal method "local")
-               (setq root (concat host ":" root) host nil))
-          ;; Normalize CVS root record
-          (list method user host root)))))
+is \"ext\".
+
+If METHOD is explicitly \"local\" or \"fork\", then the path starts
+immediately after the method block. This is used on Windows platforms
+when paths start with a drive letter.
+
+Note that, except for METHOD, which is defaulted if not present,
+other optional fields are returned as nil if not syntactically
+present, or as the empty string if delimited but empty.
+
+Returns nil in case of an unparsable CVS root (including the
+empty string) and issues a warning. This function doesn't check
+that an explicit method is valid, or that some fields are empty
+or nil but should not for a given method."
+  (let (method user password hostname port path
+               ;; IDX set by `next-delim' as a side-effect
+               idx)
+    (cl-labels
+        ((invalid (reason &rest args)
+           (apply #'lwarn '(vc-cvs) :warning
+                  (concat "vc-cvs-parse-root: Can't parse '%s': " reason)
+                  root args)
+           (cl-return-from vc-cvs-parse-root))
+         (no-path ()
+           (invalid "No path"))
+         (next-delim (start)
+           ;; Search for a :, @ or /
+           (setq idx (string-match-p "[:@/]" root start))
+           (if idx (aref root idx) (no-path)))
+         (grab-user (start end)
+           (setq user (substring root start end)))
+         (at-hostname-block (start)
+           (let ((cand (next-delim start)))
+             (cl-ecase cand
+               (?:
+                ;; Could be : before PORT and PATH, or before PASSWORD. We
+                ;; search for a @ to disambiguate.
+                (let ((colon-idx idx)
+                      (cand (next-delim (1+ idx))))
+                  (cl-ecase cand
+                    (?:
+                     (invalid (concat "Hostname block: Superfluous : at %s "
+                                      "or missing @ before")
+                              idx))
+                    (?@
+                     ;; USER:PASSWORD case
+                     (grab-user start colon-idx)
+                     (delimited-password (1+ colon-idx) idx))
+                    (?/
+                     ;; HOSTNAME[:[PORT]] case
+                     (grab-hostname start colon-idx)
+                     (delimited-port (1+ colon-idx) idx)))))
+               (?@
+                (grab-user start idx)
+                (at-hostname (1+ idx)))
+               (?/
+                (if (/= idx start)
+                    (grab-hostname start idx))
+                (at-path idx)))))
+         (delimited-password (start end)
+           (setq password (substring root start end))
+           (at-hostname (1+ end)))
+         (grab-hostname (start end)
+           (setq hostname (substring root start end)))
+         (at-hostname (start)
+           (let ((cand (next-delim start)))
+             (cl-ecase cand
+               (?:
+                (grab-hostname start idx)
+                (at-port (1+ idx)))
+               (?@
+                (invalid "Hostname: Superfluous @ after index %s" start))
+               (?/
+                (grab-hostname start idx)
+                (at-path idx)))))
+         (delimited-port (start end)
+           (setq port (substring root start end))
+           (at-path end))
+         (at-port (start)
+           (let ((end (string-match-p "/" root start)))
+             (if end (delimited-port start end) (no-path))))
+         (at-path (start)
+           (setq path (substring root start))))
+      (when (string= root "")
+        (invalid "Empty string"))
+      ;; Check for a starting ":"
+      (if (= (aref root 0) ?:)
+          ;; 3 possible cases:
+          ;; - :METHOD: at start. METHOD doesn't have any @.
+          ;; - :PASSWORD@ at start. Must be followed by HOSTNAME.
+          ;; - :[PORT] at start. Must be followed immediately by a "/".
+          ;; So, find the next character equal to ":", "@" or "/".
+          (let ((cand (next-delim 1)))
+            (cl-ecase cand
+              (?:
+               ;; :METHOD: case
+               (setq method (substring root 1 idx))
+               ;; Continue
+               (if (member method '("local" "fork"))
+                   (at-path (1+ idx))
+                 (at-hostname-block (1+ idx))))
+              (?@
+               ;; :PASSWORD@HOSTNAME case
+               (delimited-password 1 idx))
+              (?/
+               ;; :[PORT] case.
+               (at-port 1 idx))))
+        ;; No starting ":", there can't be any METHOD.
+        (at-hostname-block 0)))
+    (unless method
+      ;; Default the method if not specified
+      (setq method
+            (if (or user password hostname port) "ext" "local")))
+    (list method user hostname path)))
 
 ;; XXX: This does not work correctly for subdirectories.  "cvs status"
 ;; information is context sensitive, it contains lines like:
-- 
2.39.2