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: 4388 bytes --]

Hello Eli,

> The patch is AFAICS basically a complete rewrite of an important
> function, so I don't see how I could agree applying this to the
> release branch.  Sorry.  (Was the introduction of so many CL-isms
> really necessary, btw?)

This paragraph leaves me astonished.

First, because it is wrong: `vs-cvs-parse-root' is not a major function, it is 
a very minor one. It's not used anywhere except in `vc-cvs-repository-
hostname', which itself is not used anywhere except in `vc-cvs-stay-local-p' 
with the sole goal to deactivate Emacs caching when the CVS repository is 
local. Emacs caching can be an annoyance in certain specific cases (that's why 
I submitted the particular change you're commenting on) but in normal usage it 
is transparent (it doesn't affect correctness). Furthermore, its functionality 
is simple, very well contained, and its operation has been tested and shown to 
be better than the existing one.

Second, because "Was the introduction of so many CL-isms really necessary, 
btw?" is both unproductive and rude, and as such doubly inappropriate. If 
there is a policy of banishing CL forms, then say so, and even better, write 
it in the documentation. If there is already one (I'm not aware of any), then 
point me to it. You even didn't bother naming the constructs you're 
questioning. So let me review all candidates for you. The "so many" (!) CL-
isms are of 3 kinds only: `cl-defun', `cl-labels' and `cl-ecase'. The first is 
used to bail out early from the function without complicating code. It is much 
more appropriate from a language point of view than the `throw'/`catch' it 
expands to (to readers, and implementors as well if at some point Emacs gains 
true lexical non-local exits). The second fills an Emacs Lisp gap (definition 
of internal recursive functions), so is necessary (unless you want me to 
define these functions with `defun' whereas they are only internal and not 
meant to be called standalone, or use `let' with `lambda` forms and 
funcalls?). The third is the most concise way to express the intent, even 
before `pcase'. Sure, I could use the latter and define a catch-all case with 
an internal error, but then I'll have to do that the 4 times `cl-ecase' is 
used: 4 additional lines with no added value. Does using `cl-ecase' really 
change the face of Emacs world?

To be frank, I'm quite worried that I have to explain all that to an Emacs 
maintainer.
 
> As a minor nit, please don't use "path" or "PATH" for anything except
> $PATH-style lists of directories, as GNU Coding Standards frown on
> such use of this word.  We use "file name" or "directory name" or
> "leading directories" (as the case may be) instead.

I was not aware of it, and it took me some time to find where the GNU Coding 
Standards document says so: In a documentation section only, which is easily 
overlooked when writing code. I certainly see a logic in abiding by it in code 
as well (since code is also in part documentation). But I'll also note that 
the GNU project on this particular point goes against all established 
traditions and for dubious reasons.

I find "file name" or "directory name" even worse because they are ambiguous. 
So I've settled on using "pathname" instead (the (UNIX/Windows) "path" to some 
file, not just the filename (i.e., no slashes)). Is that OK for you?

> > Regarding the new patch, it's great to see the list of examples, but 
> > could you instead move it to a test or several inside 
> > test/lisp/vc/vc-cvs-tests.el? This file does not exist yet, but you can 
> > use vc-git-test.el as an example, in the same directory.
> 
> Yes, having a test for this would be most welcome.

The examples in the commit messages have been removed and replaced by a test 
file.

New patch attached. The only new functional change is to test for an empty 
hostname in `vc-cvs-repository-hostname', in an attempt to make it easier for 
you to see that nothing can be broken as long as `vc-cvs-parse-root' works 
correctly. Compared to the old code, the new implementation can, on an 
*invalid* CVS/Root specifications, return an empty hostname where the older 
would return nil (assuming a correct parsing case). This has no real practical 
consequences since 'cvs' commands are anyway bound to fail at a later point in 
such a case, but may reassure you about the innocuity of this change.

-- 
Olivier Certner

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

From 350718599dd34d3c06dc6c12d254e37875fe4b6a 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]]/pathname/to/repository
and for local ones:
:local:/pathname/to/repository
or
:local:c:/pathname/to/repository
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'.]

Most notably, the previous version could not parse an absolute
pathname without an explicit :local: method or :pserver: lines with
passwords.

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

(vc-cvs-repository-hostname): Cope with `vc-cvs-parse-root' returning
an empty hostname (can only happen if the "Root" file is invalid),
returning nil in this case.

(vc-cvs-parse-uhp): Remove this standalone function formerly used only
by `vc-cvs-parse-root' and which doesn't allow correct parsing anyway.

* test/lisp/vc/vc-cvs-tests.el: New file, with tests for common "Root"
file content.
---
 lisp/vc/vc-cvs.el            | 200 ++++++++++++++++++++++++-----------
 test/lisp/vc/vc-cvs-tests.el | 107 +++++++++++++++++++
 2 files changed, 244 insertions(+), 63 deletions(-)
 create mode 100644 test/lisp/vc/vc-cvs-tests.el

diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index ceebf2b2211..c6056c1e5bd 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))
 (require 'log-view)
 
 (declare-function vc-checkout "vc" (file &optional rev))
@@ -813,7 +814,10 @@ vc-cvs-stay-local-p
                             'yes 'no))))))))))))
 
 (defun vc-cvs-repository-hostname (dirname)
-  "Hostname of the CVS server associated to workarea DIRNAME."
+  "Hostname of the CVS server associated to workarea DIRNAME.
+
+Returns nil if there is not hostname or the hostname could not be
+determined because the CVS/Root specification is invalid."
   (let ((rootname (expand-file-name "CVS/Root" dirname)))
     (when (file-readable-p rootname)
       (with-temp-buffer
@@ -822,73 +826,143 @@ vc-cvs-repository-hostname
 		   default-file-name-coding-system)))
 	  (vc-insert-file rootname))
 	(goto-char (point-min))
-	(nth 2 (vc-cvs-parse-root
-		(buffer-substring (point)
-				  (line-end-position))))))))
+        (let ((hostname
+	       (nth 2 (vc-cvs-parse-root
+		       (buffer-substring (point)
+				         (line-end-position))))))
+          (unless (string= hostname "")
+            hostname))))))
 
-(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)))
+(cl-defun vc-cvs-parse-root (root)
+  "Split CVS Root specification string into a list of fields.
 
-(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
+A CVS Root specification of the form
+  [:METHOD:][[[USER][:PASSWORD]@]HOSTNAME][:[PORT]]/pathname/to/repository
 is converted to a normalized record with the following structure:
-  \(METHOD USER HOSTNAME CVS-ROOT).
+  \(METHOD USER HOSTNAME PATHNAME).
+
 The default METHOD for a CVS root of the form
-  /path/to/repository
-is `local'.
+  /pathname/to/repository
+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)))))
+  [USER@]HOSTNAME:/pathname/to/repository
+is \"ext\".
+
+If METHOD is explicitly \"local\" or \"fork\", then the pathname
+starts immediately after the method block. This must be used on
+Windows platforms when pathnames 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 pathname
+               ;; 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-pathname ()
+           (invalid "No pathname"))
+         (next-delim (start)
+           ;; Search for a :, @ or /. If none is found, there can be
+           ;; no path at the end, which is an error.
+           (setq idx (string-match-p "[:@/]" root start))
+           (if idx (aref root idx) (no-pathname)))
+         (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 PATHNAME, or before
+                ;; PASSWORD. We search for a @ to disambiguate.
+                (let ((colon-idx idx)
+                      (cand (next-delim (1+ idx))))
+                  (cl-ecase cand
+                    (?:
+                     (invalid
+                      (eval-when-compile
+                        (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-pathname 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: Unexpected @ after index %s" start))
+               (?/
+                (grab-hostname start idx)
+                (at-pathname idx)))))
+         (delimited-port (start end)
+           (setq port (substring root start end))
+           (at-pathname end))
+         (at-port (start)
+           (let ((end (string-match-p "/" root start)))
+             (if end (delimited-port start end) (no-pathname))))
+         (at-pathname (start)
+           (setq pathname (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-pathname (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 pathname)))
 
 ;; XXX: This does not work correctly for subdirectories.  "cvs status"
 ;; information is context sensitive, it contains lines like:
diff --git a/test/lisp/vc/vc-cvs-tests.el b/test/lisp/vc/vc-cvs-tests.el
new file mode 100644
index 00000000000..99ac9c8eb96
--- /dev/null
+++ b/test/lisp/vc/vc-cvs-tests.el
@@ -0,0 +1,107 @@
+;;; vc-cvs-tests.el --- tests for vc/vc-cvs.el  -*- lexical-binding:t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; Author: Olivier Certner <olce.emacs@certner.fr>
+;; Maintainer: emacs-devel@gnu.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'vc-cvs)
+
+(ert-deftest vc-cvs-test-parse-root--local-no-method ()
+  (vc-cvs-test--check-parse-root
+   "/home/joe/repo"
+   '("local" nil nil "/home/joe/repo")))
+
+(ert-deftest vc-cvs-test-parse-root--local-windows-drive-letter ()
+  (vc-cvs-test--check-parse-root
+   ":local:c:/users/joe/repo"
+   '("local" nil nil "c:/users/joe/repo")))
+
+(ert-deftest vc-cvs-test-parse-root--ext-no-method-host-no-port-colon ()
+  (vc-cvs-test--check-parse-root
+   "host/home/serv/repo"
+   '("ext" nil "host" "/home/serv/repo")))
+
+(ert-deftest vc-cvs-test-parse-root--pserver-host-no-port-colon ()
+  (vc-cvs-test--check-parse-root
+   ":pserver:host/home/serv/repo"
+   '("pserver" nil "host" "/home/serv/repo")))
+
+(ert-deftest vc-cvs-test-parse-root--pserver-host-port-colon ()
+  (vc-cvs-test--check-parse-root
+   ":pserver:host:/home/serv/repo"
+   '("pserver" nil "host" "/home/serv/repo")))
+
+(ert-deftest vc-cvs-test-parse-root--ext-no-method-user-host-no-port-colon ()
+  (vc-cvs-test--check-parse-root
+   "usr@host/home/serv/repo"
+   '("ext" "usr" "host" "/home/serv/repo")))
+
+(ert-deftest vc-cvs-test-parse-root--ext-no-method-user-host-port-colon ()
+  (vc-cvs-test--check-parse-root
+   "usr@host:/home/serv/repo"
+   '("ext" "usr" "host" "/home/serv/repo")))
+
+(ert-deftest vc-cvs-test-parse-root--pserver-user-password-host-no-port-colon ()
+  (vc-cvs-test--check-parse-root
+   ":pserver:usr:passwd@host/home/serv/repo"
+   '("pserver" "usr" "host" "/home/serv/repo")))
+
+(ert-deftest vc-cvs-test-parse-root--pserver-user-password-host-port-colon ()
+  (vc-cvs-test--check-parse-root
+   ":pserver:usr:passwd@host:/home/serv/repo"
+   '("pserver" "usr" "host" "/home/serv/repo")))
+
+(ert-deftest vc-cvs-test-parse-root--pserver-user-password-host-port ()
+  (vc-cvs-test--check-parse-root
+   ":pserver:usr:passwd@host:28/home/serv/repo"
+   '("pserver" "usr" "host" "/home/serv/repo")))
+
+;; Next 3 tests are just to err on the side of caution. It doesn't
+;; seem that CVS 1.12 can ever produce such lines.
+
+(ert-deftest
+    vc-cvs-test-parse-root--ext-no-method-user-password-host-no-port-colon
+    ()
+  (vc-cvs-test--check-parse-root
+   "usr:passwd@host/home/serv/repo"
+   '("ext" "usr" "host" "/home/serv/repo")))
+
+(ert-deftest
+    vc-cvs-test-parse-root--ext-no-method-user-password-host-port-colon
+    ()
+  (vc-cvs-test--check-parse-root
+   "usr:passwd@host:/home/serv/repo"
+   '("ext" "usr" "host" "/home/serv/repo")))
+
+(ert-deftest
+    vc-cvs-test-parse-root--ext-no-method-user-password-host-port
+    ()
+  (vc-cvs-test--check-parse-root
+   "usr:passwd@host:28/home/serv/repo"
+   '("ext" "usr" "host" "/home/serv/repo")))
+
+
+(defun vc-cvs-test--check-parse-root (input expected-output)
+  (should (equal (vc-cvs-parse-root input) expected-output)))
+
+;;; vc-cvs-tests.el ends here
-- 
2.39.2