From 8d5fc570d135c118af820db1e54a56aa7123e554 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]]/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