From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Olivier Certner Newsgroups: gmane.emacs.bugs Subject: bug#62693: 28.2; VC: CVS: Fix lost file reporting and enable reverting it Date: Mon, 17 Apr 2023 11:24:26 +0200 Message-ID: <2020915.n1Ql7ez4OO@ravel> References: <2029306.bkXEbi1Pq8@ravel> <83y1mtcx4g.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="nextPart3164790.dr8DHy2Ehi" Content-Transfer-Encoding: 7Bit Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="28193"; mail-complaints-to="usenet@ciao.gmane.io" Cc: 62693@debbugs.gnu.org To: Dmitry Gutov , Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Mon Apr 17 11:25:32 2023 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1poL75-000725-Ak for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 17 Apr 2023 11:25:31 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1poL6j-0002Ot-3e; Mon, 17 Apr 2023 05:25:09 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1poL6d-0002Od-97 for bug-gnu-emacs@gnu.org; Mon, 17 Apr 2023 05:25:03 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1poL6c-00035l-PR for bug-gnu-emacs@gnu.org; Mon, 17 Apr 2023 05:25:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1poL6c-0000An-Ai for bug-gnu-emacs@gnu.org; Mon, 17 Apr 2023 05:25:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Olivier Certner Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 17 Apr 2023 09:25:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 62693 X-GNU-PR-Package: emacs Original-Received: via spool by 62693-submit@debbugs.gnu.org id=B62693.1681723478620 (code B ref 62693); Mon, 17 Apr 2023 09:25:02 +0000 Original-Received: (at 62693) by debbugs.gnu.org; 17 Apr 2023 09:24:38 +0000 Original-Received: from localhost ([127.0.0.1]:53221 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1poL6D-00009v-1p for submit@debbugs.gnu.org; Mon, 17 Apr 2023 05:24:38 -0400 Original-Received: from smtp2-g21.free.fr ([212.27.42.2]:60166) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1poL66-00009b-G5 for 62693@debbugs.gnu.org; Mon, 17 Apr 2023 05:24:35 -0400 Original-Received: from ravel.localnet (unknown [90.118.140.172]) (Authenticated sender: ocert.dev@free.fr) by smtp2-g21.free.fr (Postfix) with ESMTPSA id B095C2003F7; Mon, 17 Apr 2023 11:24:26 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=free.fr; s=smtp-20201208; t=1681723469; bh=QHHQTEaGKtvSxj/f+5LY78NBBpj8zq798wkpkJool+8=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=T2wJYY31GXxuBI/7j/jNu/vFqNV0KYVDZjtIgdt1KlW2Pf3CmebwRZdfsgjb4AoEq +Gp0jZPf8SCsH/zIuv9AVbSOpjsvaamqgKrtIxYj2qRj5N1f6pjO/p/BQNJj7i8Bc7 8CjP5N45UVfVzs2KQB4Nz9t5elrdQ1fENMgwpSdDF349JqUycxswI0e7EZv6OW6A0Y 4vwnVr1gcthUAU0mCTohDte03OYffrm8HHtV0czcTRjZoJ6rV7Aj5NkDlbLfs/ldE9 s+xt+hJz+6FySrmiOvE/ch8RFkgN8U+RgqonbucRXx/D4J5Cyp4AQXTTqK8sy8Taf2 j/UPWqLz+sw2w== In-Reply-To: <83y1mtcx4g.fsf@gnu.org> X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:260179 Archived-At: This is a multi-part message in MIME format. --nextPart3164790.dr8DHy2Ehi Content-Transfer-Encoding: 7Bit Content-Type: text/plain; charset="UTF-8" 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 --nextPart3164790.dr8DHy2Ehi Content-Disposition: attachment; filename="0001-VC-CVS-Fix-Root-file-parsing.patch" Content-Transfer-Encoding: 7Bit Content-Type: text/x-patch; charset="unicode-2-0-utf-8"; name="0001-VC-CVS-Fix-Root-file-parsing.patch" >From 350718599dd34d3c06dc6c12d254e37875fe4b6a Mon Sep 17 00:00:00 2001 From: Olivier Certner 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 +;; 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 . + +;;; 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 --nextPart3164790.dr8DHy2Ehi--