procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Make use of rx in Tramp backward compatoble

Browse source 
* lisp/net/tramp-compat.el (tramp-compat-rx--runtime-params): New defvar.
(tramp-compat-rx--transform-items)
(tramp-compat-rx--transform-item, tramp-compat-rx--transform):
New defuns.  Suggested by Mattias Engdegård <mattiase@acm.org>.
(tramp-compat-rx): New defalias or defmacro.
(tramp-compat-string-replace, tramp-compat-string-search):
Use regexp-quote.

* lisp/net/tramp.el:
* lisp/net/tramp-adb.el:
* lisp/net/tramp-archive.el:
* lisp/net/tramp-cmds.el:
* lisp/net/tramp-crypt.el:
* lisp/net/tramp-fuse.el:
* lisp/net/tramp-gvfs.el:
* lisp/net/tramp-sh.el:
* lisp/net/tramp-smb.el:
* lisp/net/tramp-sudoedit.el: Use `tramp-compat-rx' where indicated.

* test/lisp/net/tramp-archive-tests.el:
* test/lisp/net/tramp-tests.el: Use `tramp-compat-rx' where indicated.
This commit is contained in:
Michael Albinus 2022-09-09 17:10:28 +02:00
parent 72c64dd73c
commit 08cc6c4d9e
13 changed files with 453 additions and 314 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
lisp/net/tramp-adb.el
View file

@ -71,20 +71,22 @@ It is used for TCP/IP devices."
"Regexp for date time format in ls output."))
(defconst tramp-adb-ls-date-regexp
(rx blank (regexp tramp-adb-ls-date-year-regexp)
blank (regexp tramp-adb-ls-date-time-regexp)
blank)
(tramp-compat-rx
blank (regexp tramp-adb-ls-date-year-regexp)
blank (regexp tramp-adb-ls-date-time-regexp)
blank)
"Regexp for date format in ls output.")
(defconst tramp-adb-ls-toolbox-regexp
(rx bol (* blank) (group (+ (any ".-" alpha))) ; \1 permissions
(? (+ blank) (+ digit)) ; links (Android 7/toybox)
(* blank) (group (+ (not blank))) ; \2 username
(+ blank) (group (+ (not blank))) ; \3 group
(+ blank) (group (+ digit)) ; \4 size
(+ blank) (group (regexp tramp-adb-ls-date-year-regexp)
blank (regexp tramp-adb-ls-date-time-regexp)) ; \5 date
blank (group (* nonl)) eol) ; \6 filename
(tramp-compat-rx
bol (* blank) (group (+ (any ".-" alpha))) ; \1 permissions
(? (+ blank) (+ digit)) ; links (Android 7/toybox)
(* blank) (group (+ (not blank))) ; \2 username
(+ blank) (group (+ (not blank))) ; \3 group
(+ blank) (group (+ digit)) ; \4 size
(+ blank) (group (regexp tramp-adb-ls-date-year-regexp)
blank (regexp tramp-adb-ls-date-time-regexp)) ; \5 date
blank (group (* nonl)) eol) ; \6 filename
"Regexp for ls output.")
;;;###tramp-autoload
@ -324,8 +326,8 @@ arguments to pass to the OPERATION."
(tramp-shell-quote-argument
(tramp-compat-file-name-concat localname ".."))))
(tramp-compat-replace-regexp-in-region
(rx (literal (tramp-compat-file-name-unquote
(file-name-as-directory localname))))
(tramp-compat-rx (literal (tramp-compat-file-name-unquote
(file-name-as-directory localname))))
"" (point-min))
(widen)))
(tramp-adb-sh-fix-ls-output)
@ -363,12 +365,14 @@ Emacs dired can't find files."
(goto-char (point-min))
(while
(search-forward-regexp
(rx blank (group blank (regexp tramp-adb-ls-date-year-regexp) blank))
(tramp-compat-rx
blank (group blank (regexp tramp-adb-ls-date-year-regexp) blank))
nil t)
(replace-match "0\\1" "\\1" nil)
;; Insert missing "/".
(when (looking-at-p
(rx (regexp tramp-adb-ls-date-time-regexp) (+ blank) eol))
(tramp-compat-rx
(regexp tramp-adb-ls-date-time-regexp) (+ blank) eol))
(end-of-line)
(insert "/")))
;; Sort entries.
@ -944,7 +948,7 @@ implementation will be used."
(i 0)
p)
(when (string-match-p (rx multibyte) command)
(when (string-match-p (tramp-compat-rx multibyte) command)
(tramp-error
v 'file-error "Cannot apply multi-byte command `%s'" command))
@ -1136,7 +1140,7 @@ error and non-nil on success."
(defun tramp-adb-send-command (vec command &optional neveropen nooutput)
"Send the COMMAND to connection VEC."
(if (string-match-p (rx multibyte) command)
(if (string-match-p (tramp-compat-rx multibyte) command)
;; Multibyte codepoints with four bytes are not supported at
;; least by toybox.
@ -1160,7 +1164,7 @@ error and non-nil on success."
;; We can't use stty to disable echo of command. stty is said
;; to be added to toybox 0.7.6. busybox shall have it, but this
;; isn't used any longer for Android.
(delete-matching-lines (rx bol (literal command) eol))
(delete-matching-lines (tramp-compat-rx bol (literal command) eol))
;; When the local machine is W32, there are still trailing ^M.
;; There must be a better solution by setting the correct coding
;; system, but this requires changes in core Tramp.
@ -1283,7 +1287,7 @@ connection if a previous connection has died for some reason."
;; Change prompt.
(tramp-set-connection-property
p "prompt" (rx "///" (literal prompt) "#$"))
p "prompt" (tramp-compat-rx "///" (literal prompt) "#$"))
(tramp-adb-send-command
vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt))

23
lisp/net/tramp-archive.el
View file

@ -184,17 +184,18 @@ It must be supported by libarchive(3).")
;;;###autoload
(progn (defmacro tramp-archive-autoload-file-name-regexp ()
"Regular expression matching archive file names."
'(rx bos
;; This group is used in `tramp-archive-file-name-archive'.
(group
(+ nonl)
;; Default suffixes ...
"." (regexp (regexp-opt tramp-archive-suffixes))
;; ... with compression.
(? "." (regexp (regexp-opt tramp-archive-compression-suffixes))))
;; This group is used in `tramp-archive-file-name-localname'.
(group "/" (* nonl))
eos)))
`(rx
bos
;; This group is used in `tramp-archive-file-name-archive'.
(group
(+ nonl)
;; Default suffixes ...
"." ,(cons '| tramp-archive-suffixes)
;; ... with compression.
(? "." ,(cons '| tramp-archive-compression-suffixes)))
;; This group is used in `tramp-archive-file-name-localname'.
(group "/" (* nonl))
eos)))
(put #'tramp-archive-autoload-file-name-regexp 'tramp-autoload t)

13
lisp/net/tramp-cmds.el
View file

@ -355,7 +355,7 @@ The remote connection identified by SOURCE is flushed by
(dir (tramp-rename-read-file-name-dir default))
(init (tramp-rename-read-file-name-init default))
(tramp-ignored-file-name-regexp
(rx (literal (file-remote-p source)))))
(tramp-compat-rx (literal (file-remote-p source)))))
(read-file-name-default
"Enter new Tramp connection: "
dir default 'confirm init #'file-directory-p)))))
@ -466,7 +466,7 @@ For details, see `tramp-rename-files'."
(dir (tramp-rename-read-file-name-dir default))
(init (tramp-rename-read-file-name-init default))
(tramp-ignored-file-name-regexp
(rx (literal (file-remote-p source)))))
(tramp-compat-rx (literal (file-remote-p source)))))
(read-file-name-default
(format "Change Tramp connection `%s': " source)
dir default 'confirm init #'file-directory-p)))))
@ -621,10 +621,11 @@ buffer in your bug report.
(unless (hash-table-p val)
;; Remove string quotation.
(when (looking-at
(rx bol (group (* anychar)) "\"" ;; \1 "
(group "(base64-decode-string ") "\\" ;; \2 \
(group "\"" (* anychar)) "\\" ;; \3 \
(group "\")") "\"" eol)) ;; \4 "
(tramp-compat-rx
bol (group (* anychar)) "\"" ;; \1 "
(group "(base64-decode-string ") "\\" ;; \2 \
(group "\"" (* anychar)) "\\" ;; \3 \
(group "\")") "\"" eol)) ;; \4 "
(replace-match "\\1\\2\\3\\4")
(beginning-of-line)
(insert " ;; Variable encoded due to non-printable characters.\n")))

46
lisp/net/tramp-compat.el
View file

@ -180,6 +180,48 @@ CONDITION can also be a list of error conditions."
(declare (debug t) (indent 1))
`(condition-case nil (progn ,@body) (,condition nil)))
;; `rx' in Emacs 26 doesn't know the `literal', `anychar' and
;; `multibyte' constructs. The `not' construct requires an `any'
;; construct as argument. The `regexp' construct requires a literal
;; string.
(defvar tramp-compat-rx--runtime-params)
(defun tramp-compat-rx--transform-items (items)
(mapcar #'tramp-compat-rx--transform-item items))
;; There is an error in Emacs 26. `(rx "a" (? ""))' => "a?".
;; We must protect the string in regexp and literal, therefore.
(defun tramp-compat-rx--transform-item (item)
(pcase item
('anychar 'anything)
('multibyte 'nonascii)
(`(not ,expr)
(if (consp expr) item (list 'not (list 'any expr))))
(`(regexp ,expr)
(setq tramp-compat-rx--runtime-params t)
`(regexp ,(list '\, `(concat "\\(?:" ,expr "\\)"))))
(`(literal ,expr)
(setq tramp-compat-rx--runtime-params t)
`(regexp ,(list '\, `(concat "\\(?:" (regexp-quote ,expr) "\\)"))))
(`(eval . ,_) item)
(`(,head . ,rest) (cons head (tramp-compat-rx--transform-items rest)))
(_ item)))
(defun tramp-compat-rx--transform (items)
(let* ((tramp-compat-rx--runtime-params nil)
(new-rx (cons ': (tramp-compat-rx--transform-items items))))
(if tramp-compat-rx--runtime-params
`(rx-to-string ,(list '\` new-rx) t)
(rx-to-string new-rx t))))
(if (ignore-errors (rx-to-string '(literal "a"))) ;; Emacs 27+.
(defalias 'tramp-compat-rx #'rx)
(defmacro tramp-compat-rx (&rest items)
(tramp-compat-rx--transform items)))
;; This is needed for compilation in the Emacs source tree.
;;;###autoload (defalias 'tramp-compat-rx #'rx)
;; `file-modes', `set-file-modes' and `set-file-times' got argument
;; FLAG in Emacs 28.1.
(defalias 'tramp-compat-file-modes
@ -237,7 +279,7 @@ CONDITION can also be a list of error conditions."
(lambda (from-string to-string in-string)
(let (case-fold-search)
(replace-regexp-in-string
(rx (literal from-string)) to-string in-string t t)))))
(regexp-quote from-string) to-string in-string t t)))))
;; Function `string-search' is new in Emacs 28.1.
(defalias 'tramp-compat-string-search
@ -245,7 +287,7 @@ CONDITION can also be a list of error conditions."
#'string-search
(lambda (needle haystack &optional start-pos)
(let (case-fold-search)
(string-match-p (rx (literal needle)) haystack start-pos)))))
(string-match-p (regexp-quote needle) haystack start-pos)))))
;; Function `make-lock-file-name' is new in Emacs 28.1.
(defalias 'tramp-compat-make-lock-file-name

4
lisp/net/tramp-crypt.el
View file

@ -555,7 +555,7 @@ localname."
(defun tramp-crypt-handle-access-file (filename string)
"Like `access-file' for Tramp files."
(let* ((encrypt-filename (tramp-crypt-encrypt-file-name filename))
(encrypt-regexp (rx (literal encrypt-filename) eos))
(encrypt-regexp (tramp-compat-rx (literal encrypt-filename) eos))
tramp-crypt-enabled)
(condition-case err
(access-file encrypt-filename string)
@ -707,7 +707,7 @@ absolute file names."
(mapcar
(lambda (x)
(replace-regexp-in-string
(rx bos (literal directory)) ""
(tramp-compat-rx bos (literal directory)) ""
(tramp-crypt-decrypt-file-name x)))
(directory-files (tramp-crypt-encrypt-file-name directory) 'full)))))

12
lisp/net/tramp-fuse.el
View file

@ -69,10 +69,11 @@
(tramp-fuse-local-file-name directory))))))))
(if full
;; Massage the result.
(let ((local (rx bol
(literal
(tramp-fuse-mount-point
(tramp-dissect-file-name directory)))))
(let ((local (tramp-compat-rx
bol
(literal
(tramp-fuse-mount-point
(tramp-dissect-file-name directory)))))
(remote (directory-file-name
(funcall
(if (tramp-compat-file-name-quoted-p directory)
@ -179,7 +180,8 @@ It has the same meaning as `remote-file-name-inhibit-cache'.")
(tramp-set-file-property
vec "/" "mounted"
(when (string-match
(rx bol (group (literal (tramp-fuse-mount-spec vec))) blank)
(tramp-compat-rx
bol (group (literal (tramp-fuse-mount-spec vec))) blank)
mount)
(match-string 1 mount)))))))

77
lisp/net/tramp-gvfs.el
View file

@ -414,9 +414,10 @@ It has been changed in GVFS 1.14.")
;; </interface>
(defconst tramp-goa-identity-regexp
(rx bol (? (group (regexp tramp-user-regexp)))
"@" (? (group (regexp tramp-host-regexp)))
(? ":" (group (regexp tramp-port-regexp))))
(tramp-compat-rx
bol (? (group (regexp tramp-user-regexp)))
"@" (? (group (regexp tramp-host-regexp)))
(? ":" (group (regexp tramp-port-regexp))))
"Regexp matching GNOME Online Accounts \"PresentationIdentity\" property.")
(defconst tramp-goa-interface-mail "org.gnome.OnlineAccounts.Mail"
@ -715,13 +716,15 @@ It has been changed in GVFS 1.14.")
"GVFS file attributes."))
(defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp
(rx blank (group (regexp (regexp-opt tramp-gvfs-file-attributes)))
"=" (group (+? nonl)))
(tramp-compat-rx
blank (group (regexp (regexp-opt tramp-gvfs-file-attributes)))
"=" (group (+? nonl)))
"Regexp to parse GVFS file attributes with `gvfs-ls'.")
(defconst tramp-gvfs-file-attributes-with-gvfs-info-regexp
(rx bol (* blank) (group (regexp (regexp-opt tramp-gvfs-file-attributes)))
":" (+ blank) (group (* nonl)) eol)
(tramp-compat-rx
bol (* blank) (group (regexp (regexp-opt tramp-gvfs-file-attributes)))
":" (+ blank) (group (* nonl)) eol)
"Regexp to parse GVFS file attributes with `gvfs-info'.")
(defconst tramp-gvfs-file-system-attributes
@ -731,16 +734,17 @@ It has been changed in GVFS 1.14.")
"GVFS file system attributes.")
(defconst tramp-gvfs-file-system-attributes-regexp
(rx bol (* blank)
(group (regexp (regexp-opt tramp-gvfs-file-system-attributes)))
":" (+ blank) (group (* nonl)) eol)
(tramp-compat-rx
bol (* blank)
(group (regexp (regexp-opt tramp-gvfs-file-system-attributes)))
":" (+ blank) (group (* nonl)) eol)
"Regexp to parse GVFS file system attributes with `gvfs-info'.")
(defconst tramp-gvfs-nextcloud-default-prefix "/remote.php/webdav"
"Default prefix for owncloud / nextcloud methods.")
(defconst tramp-gvfs-nextcloud-default-prefix-regexp
(rx (literal tramp-gvfs-nextcloud-default-prefix) eol)
(tramp-compat-rx (literal tramp-gvfs-nextcloud-default-prefix) eol)
"Regexp of default prefix for owncloud / nextcloud methods.")
@ -1162,7 +1166,7 @@ file names."
(with-parsed-tramp-file-name name nil
;; If there is a default location, expand tilde.
(when (string-match
(rx bos "~" (group (* (not (any "/")))) (group (* nonl)) eos)
(tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl)) eos)
localname)
(let ((uname (match-string 1 localname))
(fname (match-string 2 localname))
@ -1180,7 +1184,7 @@ file names."
;; We do not pass "/..".
(if (string-match-p (rx bos (| "afp" (: "dav" (? "s")) "smb") eos) method)
(when (string-match
(rx bos "/" (+ (not (any "/"))) (group "/.." (? "/")))
(tramp-compat-rx bos "/" (+ (not "/")) (group "/.." (? "/")))
localname)
(setq localname (replace-match "/" t t localname 1)))
(when (string-match (rx bol "/.." (? "/")) localname)
@ -1216,20 +1220,22 @@ file names."
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(while (looking-at
(rx bol (group (+ nonl)) blank
(group (+ digit)) blank
"(" (group (+? nonl)) ")"
(regexp tramp-gvfs-file-attributes-with-gvfs-ls-regexp)))
(tramp-compat-rx
bol (group (+ nonl)) blank
(group (+ digit)) blank
"(" (group (+? nonl)) ")"
(regexp tramp-gvfs-file-attributes-with-gvfs-ls-regexp)))
(let ((item (list (cons "type" (match-string 3))
(cons "standard::size" (match-string 2))
(cons "name" (match-string 1)))))
(goto-char (1+ (match-end 3)))
(while (looking-at
(rx (regexp tramp-gvfs-file-attributes-with-gvfs-ls-regexp)
(group
(| (regexp
tramp-gvfs-file-attributes-with-gvfs-ls-regexp)
eol))))
(tramp-compat-rx
(regexp tramp-gvfs-file-attributes-with-gvfs-ls-regexp)
(group
(| (regexp
tramp-gvfs-file-attributes-with-gvfs-ls-regexp)
eol))))
(push (cons (match-string 1) (match-string 2)) item)
(goto-char (match-end 2)))
;; Add display name as head.
@ -1277,7 +1283,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(if (or (and (string-match-p
(rx bol (| "afp" (: "dav" (? "s")) "smb") eol) method)
(string-match-p
(rx bol (? "/") (+ (not (any "/"))) eol) localname))
(tramp-compat-rx bol (? "/") (+ (not "/")) eol) localname))
(string-equal localname "/"))
(tramp-gvfs-get-root-attributes filename)
(assoc
@ -1477,7 +1483,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(let* ((events (process-get proc 'events))
(rest-string (process-get proc 'rest-string))
(dd (tramp-get-default-directory (process-buffer proc)))
(ddu (rx (literal (tramp-gvfs-url-file-name dd)))))
(ddu (tramp-compat-rx (literal (tramp-gvfs-url-file-name dd)))))
(when rest-string
(tramp-message proc 10 "Previous string:\n%s" rest-string))
(tramp-message proc 6 "%S\n%s" proc string)
@ -1496,10 +1502,11 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(delete-process proc))
(while (string-match
(rx bol (+ nonl) ":"
blank (group (+ nonl)) ":"
blank (group (regexp (regexp-opt tramp-gio-events)))
(? (group blank (group (+ nonl)))) eol)
(tramp-compat-rx
bol (+ nonl) ":"
blank (group (+ nonl)) ":"
blank (group (regexp (regexp-opt tramp-gio-events)))
(? (group blank (group (+ nonl)))) eol)
string)
(let ((file (match-string 1 string))
@ -1730,7 +1737,8 @@ ID-FORMAT valid values are `string' and `integer'."
"Retrieve file name from D-Bus OBJECT-PATH."
(dbus-unescape-from-identifier
(replace-regexp-in-string
(rx bol (* nonl) "/" (group (+ (not (any "/")))) eol) "\\1" object-path)))
(tramp-compat-rx bol (* nonl) "/" (group (+ (not "/"))) eol) "\\1"
object-path)))
(defun tramp-gvfs-url-host (url)
"Return the host name part of URL, a string.
@ -2005,8 +2013,9 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\" and
(string-equal domain (tramp-file-name-domain vec))
(string-equal host (tramp-file-name-host vec))
(string-equal port (tramp-file-name-port vec))
(string-match-p (rx bol "/" (literal (or share "")))
(tramp-file-name-unquote-localname vec)))
(string-match-p
(tramp-compat-rx bol "/" (literal (or share "")))
(tramp-file-name-unquote-localname vec)))
;; Set mountpoint and location.
(tramp-set-file-property vec "/" "fuse-mountpoint" fuse-mountpoint)
(tramp-set-connection-property
@ -2050,7 +2059,8 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
(tramp-media-device-port media) (tramp-file-name-port vec)))
(localname (tramp-file-name-unquote-localname vec))
(share (when (string-match
(rx bol (? "/") (group (+ (not (any "/"))))) localname)
(tramp-compat-rx bol (? "/") (group (+ (not "/"))))
localname)
(match-string 1 localname)))
(ssl (if (string-match-p (rx bol (| "davs" "nextcloud")) method)
"true" "false"))
@ -2093,7 +2103,8 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
(list (tramp-gvfs-mount-spec-entry "port" port)))))
(mount-pref
(if (and (string-match-p (rx bol "dav") method)
(string-match (rx bol (? "/") (+ (not (any "/")))) localname))
(string-match
(tramp-compat-rx bol (? "/") (+ (not "/"))) localname))
(match-string 0 localname)
(tramp-gvfs-get-remote-prefix vec))))

98
lisp/net/tramp-sh.el
View file

@ -411,7 +411,7 @@ The string is used in `tramp-methods'.")
(add-to-list 'tramp-default-method-alist
`(,tramp-local-host-regexp
,(rx bos (literal tramp-root-id-string) eos) "su"))
,(tramp-compat-rx bos (literal tramp-root-id-string) eos) "su"))
(add-to-list 'tramp-default-user-alist
`(,(rx bos (| "su" "sudo" "doas" "ksu") eos)
@ -1635,10 +1635,11 @@ ID-FORMAT valid values are `string' and `integer'."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-selinux-context"
(let ((context '(nil nil nil nil))
(regexp (rx (group (+ (any "_" alnum))) ":"
(group (+ (any "_" alnum))) ":"
(group (+ (any "_" alnum))) ":"
(group (+ (any "_" alnum))))))
(regexp (tramp-compat-rx
(group (+ (any "_" alnum))) ":"
(group (+ (any "_" alnum))) ":"
(group (+ (any "_" alnum))) ":"
(group (+ (any "_" alnum))))))
(when (and (tramp-remote-selinux-p v)
(tramp-send-command-and-check
v (format
@ -2828,7 +2829,8 @@ the result will be a local, non-Tramp, file name."
;; by `file-name-absolute-p'.
(if (and (eq system-type 'windows-nt)
(string-match-p
(rx bol (| (: alpha ":") (: (literal null-device) eol))) name))
(tramp-compat-rx bol (| (: alpha ":") (: (literal null-device) eol)))
name))
(tramp-run-real-handler #'expand-file-name (list name dir))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
@ -2845,7 +2847,8 @@ the result will be a local, non-Tramp, file name."
;; supposed to find such a shell on the remote host. Please
;; tell me about it when this doesn't work on your system.
(when (string-match
(rx bos "~" (group (* (not (any "/")))) (group (* nonl)) eos)
(tramp-compat-rx
bos "~" (group (* (not "/"))) (group (* nonl)) eos)
localname)
(let ((uname (match-string 1 localname))
(fname (match-string 2 localname))
@ -3917,10 +3920,11 @@ Fall back to normal file name handler if no Tramp handler exists."
(setq string (tramp-compat-string-replace "\n\n" "\n" string))
(while (string-match
(rx bol (+ (not (any ":"))) ":" blank
(group (+ (not (any ":")))) ":" blank
(group (regexp (regexp-opt tramp-gio-events)))
(? blank (group (+ (not (any ":"))))) eol)
(tramp-compat-rx
bol (+ (not ":")) ":" blank
(group (+ (not ":"))) ":" blank
(group (regexp (regexp-opt tramp-gio-events)))
(? blank (group (+ (not ":")))) eol)
string)
(let* ((file (match-string 1 string))
@ -4020,55 +4024,65 @@ replaced by a temporary file name. If VEC is nil, the respective
local commands are used. If there is a format specifier which
cannot be expanded, this function returns nil."
(if (not (string-match-p
(rx (| bol (not (any "%"))) "%" (any "ahlnoprsty")) script))
(tramp-compat-rx (| bol (not "%")) "%" (any "ahlnoprsty")) script))
script
(catch 'wont-work
(let ((awk (when (string-match-p (rx (| bol (not (any "%"))) "%a") script)
(let ((awk (when (string-match-p
(tramp-compat-rx (| bol (not "%")) "%a") script)
(or
(if vec (tramp-get-remote-awk vec) (executable-find "awk"))
(throw 'wont-work nil))))
(hdmp (when (string-match-p (rx (| bol (not (any "%"))) "%h") script)
(hdmp (when (string-match-p
(tramp-compat-rx (| bol (not "%")) "%h") script)
(or
(if vec (tramp-get-remote-hexdump vec)
(executable-find "hexdump"))
(throw 'wont-work nil))))
(dev (when (string-match-p (rx (| bol (not (any "%"))) "%n") script)
(dev (when (string-match-p
(tramp-compat-rx (| bol (not "%")) "%n") script)
(or
(if vec (concat "2>" (tramp-get-remote-null-device vec))
(if (eq system-type 'windows-nt) ""
(concat "2>" null-device)))
(throw 'wont-work nil))))
(ls (when (string-match-p (rx (| bol (not (any "%"))) "%l") script)
(ls (when (string-match-p
(tramp-compat-rx (| bol (not "%")) "%l") script)
(format "%s %s"
(or (tramp-get-ls-command vec)
(throw 'wont-work nil))
(tramp-sh--quoting-style-options vec))))
(od (when (string-match-p (rx (| bol (not (any "%"))) "%o") script)
(od (when (string-match-p
(tramp-compat-rx (| bol (not "%")) "%o") script)
(or (if vec (tramp-get-remote-od vec) (executable-find "od"))
(throw 'wont-work nil))))
(perl (when (string-match-p (rx (| bol (not (any "%"))) "%p") script)
(perl (when (string-match-p
(tramp-compat-rx (| bol (not "%")) "%p") script)
(or
(if vec
(tramp-get-remote-perl vec) (executable-find "perl"))
(throw 'wont-work nil))))
(python (when (string-match-p (rx (| bol (not (any "%"))) "%y") script)
(python (when (string-match-p
(tramp-compat-rx (| bol (not "%")) "%y") script)
(or
(if vec
(tramp-get-remote-python vec) (executable-find "python"))
(tramp-get-remote-python vec)
(executable-find "python"))
(throw 'wont-work nil))))
(readlink (when (string-match-p
(rx (| bol (not (any "%"))) "%r") script)
(tramp-compat-rx (| bol (not "%")) "%r") script)
(or
(if vec
(tramp-get-remote-readlink vec)
(executable-find "readlink"))
(throw 'wont-work nil))))
(stat (when (string-match-p (rx (| bol (not (any "%"))) "%s") script)
(stat (when (string-match-p
(tramp-compat-rx (| bol (not "%")) "%s") script)
(or
(if vec
(tramp-get-remote-stat vec) (executable-find "stat"))
(throw 'wont-work nil))))
(tmp (when (string-match-p (rx (| bol (not (any "%"))) "%t") script)
(tmp (when (string-match-p
(tramp-compat-rx (| bol (not "%")) "%t") script)
(or
(if vec
(tramp-file-local-name (tramp-make-tramp-temp-name vec))
@ -4329,7 +4343,8 @@ file exists and nonzero exit status otherwise."
"Couldn't find remote shell prompt for %s" shell)
(unless
(tramp-check-for-regexp
(tramp-get-connection-process vec) (rx (literal tramp-end-of-output)))
(tramp-get-connection-process vec)
(tramp-compat-rx (literal tramp-end-of-output)))
(tramp-wait-for-output (tramp-get-connection-process vec))
(tramp-message vec 5 "Setting shell prompt")
(tramp-send-command
@ -4370,7 +4385,8 @@ file exists and nonzero exit status otherwise."
(tramp-send-command
vec (format "echo ~%s" tramp-root-id-string) t)
(if (or (string-match-p
(rx bol "~" (literal tramp-root-id-string) eol)
(tramp-compat-rx
bol "~" (literal tramp-root-id-string) eol)
(buffer-string))
;; The default shell (ksh93) of OpenSolaris
;; and Solaris is buggy. We've got reports
@ -4409,9 +4425,9 @@ seconds. If not, it produces an error message with the given ERROR-ARGS."
(condition-case nil
(tramp-wait-for-regexp
proc timeout
(rx (| (regexp shell-prompt-pattern)
(regexp tramp-shell-prompt-pattern))
eos))
(tramp-compat-rx
(| (regexp shell-prompt-pattern) (regexp tramp-shell-prompt-pattern))
eos))
(error
(delete-process proc)
(apply #'tramp-error-with-buffer
@ -4771,7 +4787,7 @@ Goes through the list `tramp-local-coding-commands' and
(with-current-buffer (tramp-get-connection-buffer vec)
(goto-char (point-min))
(unless (looking-at-p (rx (literal magic)))
(unless (looking-at-p (tramp-compat-rx (literal magic)))
(throw 'wont-work-remote nil)))
;; `rem-enc' and `rem-dec' could be a string meanwhile.
@ -4857,7 +4873,7 @@ Goes through the list `tramp-inline-compress-commands'."
nil t))
(throw 'next nil))
(goto-char (point-min))
(unless (looking-at-p (rx (literal magic)))
(unless (looking-at-p (tramp-compat-rx (literal magic)))
(throw 'next nil)))
(tramp-message
vec 5
@ -4868,7 +4884,7 @@ Goes through the list `tramp-inline-compress-commands'."
(throw 'next nil))
(with-current-buffer (tramp-get-buffer vec)
(goto-char (point-min))
(unless (looking-at-p (rx (literal magic)))
(unless (looking-at-p (tramp-compat-rx (literal magic)))
(throw 'next nil)))
(setq found t)))
@ -5357,14 +5373,15 @@ function waits for output unless NOOUTPUT is set."
;; Busyboxes built with the EDITING_ASK_TERMINAL config
;; option send also escape sequences, which must be
;; ignored.
(regexp (rx (* (not (any "#$\n")))
(literal tramp-end-of-output)
(? (regexp tramp-device-escape-sequence-regexp))
(? "\r") eol))
(regexp (tramp-compat-rx
(* (not (any "#$\n")))
(literal tramp-end-of-output)
(? (regexp tramp-device-escape-sequence-regexp))
(? "\r") eol))
;; Sometimes, the commands do not return a newline but a
;; null byte before the shell prompt, for example "git
;; ls-files -c -z ...".
(regexp1 (rx (| bol "\000") (regexp regexp)))
(regexp1 (tramp-compat-rx (| bol "\000") (regexp regexp)))
(found (tramp-wait-for-regexp proc timeout regexp1)))
(if found
(let ((inhibit-read-only t))
@ -5404,7 +5421,8 @@ the exit status."
(let (cmd data)
(if (and (stringp command)
(string-match
(rx (* nonl) "<<'" (literal tramp-end-of-heredoc) "'" (* nonl))
(tramp-compat-rx
(* nonl) "<<'" (literal tramp-end-of-heredoc) "'" (* nonl))
command))
(setq cmd (match-string 0 command)
data (substring command (match-end 0)))
@ -5574,7 +5592,7 @@ Nonexistent directories are removed from spec."
(tramp-get-method-parameter vec 'tramp-remote-shell-args)
" ")
(tramp-shell-quote-argument tramp-end-of-heredoc))
'noerror (rx (literal tramp-end-of-heredoc)))
'noerror (tramp-compat-rx (literal tramp-end-of-heredoc)))
(progn
(tramp-message
vec 2 "Could not retrieve `tramp-own-remote-path'")
@ -5624,7 +5642,7 @@ Nonexistent directories are removed from spec."
(while candidates
(goto-char (point-min))
(if (string-match-p
(rx bol (literal (car candidates)) (? "\r") eol)
(tramp-compat-rx bol (literal (car candidates)) (? "\r") eol)
(buffer-string))
(setq locale (car candidates)
candidates nil)
@ -5703,7 +5721,7 @@ Nonexistent directories are removed from spec."
vec (format "( %s / -nt / )" (tramp-get-test-command vec)))
(with-current-buffer (tramp-get-buffer vec)
(goto-char (point-min))
(when (looking-at-p (rx (literal tramp-end-of-output)))
(when (looking-at-p (tramp-compat-rx (literal tramp-end-of-output)))
(format "%s %%s -nt %%s" (tramp-get-test-command vec)))))
(progn
(tramp-send-command

22
lisp/net/tramp-smb.el
View file

@ -53,7 +53,7 @@
;;;###tramp-autoload
(tramp--with-startup
(add-to-list 'tramp-default-user-alist
`(,(rx bos (literal tramp-smb-method) eos) nil nil))
`(,(tramp-compat-rx bos (literal tramp-smb-method) eos) nil nil))
;; Add completion function for SMB method.
(tramp-set-completion-function
@ -92,9 +92,9 @@ this variable \"client min protocol=NT1\"."
"Version string of the SMB client.")
(defconst tramp-smb-server-version
(rx "Domain=[" (* (not (any "]"))) "] "
"OS=[" (* (not (any "]"))) "] "
"Server=[" (* (not (any "]"))) "]")
(tramp-compat-rx "Domain=[" (* (not "]")) "] "
"OS=[" (* (not "]")) "] "
"Server=[" (* (not "]")) "]")
"Regexp of SMB server identification.")
(defconst tramp-smb-prompt
@ -729,7 +729,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(with-parsed-tramp-file-name name nil
;; Tilde expansion if necessary.
(when (string-match
(rx bos "~" (group (* (not (any "/")))) (group (* nonl)) eos)
(tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl)) eos)
localname)
(let ((uname (match-string 1 localname))
(fname (match-string 2 localname))
@ -1082,7 +1082,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; Check for matching entries.
(mapcar
(lambda (x)
(when (string-match-p (rx bol (literal base)) (nth 0 x))
(when (string-match-p
(tramp-compat-rx bol (literal base)) (nth 0 x))
x))
entries)
;; We just need the only and only entry FILENAME.
@ -1632,7 +1633,7 @@ VEC or USER, or if there is no home directory, return nil."
(save-match-data
(let ((localname (tramp-file-name-unquote-localname vec)))
(when (string-match
(rx bol (? "/") (group (+ (not (any "/")))) "/") localname)
(tramp-compat-rx bol (? "/") (group (+ (not "/"))) "/") localname)
(match-string 1 localname)))))
(defun tramp-smb-get-localname (vec)
@ -1643,7 +1644,8 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"."
(setq
localname
(if (string-match
(rx bol (? "/") (+ (not (any "/"))) (group "/" (* nonl))) localname)
(tramp-compat-rx bol (? "/") (+ (not "/")) (group "/" (* nonl)))
localname)
;; There is a share, separated by "/".
(if (not (tramp-smb-get-cifs-capabilities vec))
(mapconcat
@ -1652,7 +1654,7 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"."
(match-string 1 localname))
;; There is just a share.
(if (string-match
(rx bol (? "/") (group (+ (not (any "/")))) eol) localname)
(tramp-compat-rx bol (? "/") (group (+ (not "/"))) eol) localname)
(match-string 1 localname)
"")))
@ -1781,7 +1783,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)."
;; Read share entries.
(when (string-match
(rx bol "Disk|" (group (+ (not (any "|")))) "|") line)
(tramp-compat-rx bol "Disk|" (group (+ (not "|"))) "|") line)
(setq localname (match-string 1 line)
mode "dr-xr-xr-x"
size 0))

13
lisp/net/tramp-sudoedit.el
View file

@ -49,7 +49,7 @@
(tramp-password-previous-hop t)))
(add-to-list 'tramp-default-user-alist
`(,(rx bos (literal tramp-sudoedit-method) eos)
`(,(tramp-compat-rx bos (literal tramp-sudoedit-method) eos)
nil ,tramp-root-id-string))
(tramp-set-completion-function
@ -377,7 +377,7 @@ the result will be a local, non-Tramp, file name."
(unless (file-name-absolute-p localname)
(setq localname (format "~%s/%s" user localname)))
(when (string-match
(rx bos "~" (group (* (not (any "/")))) (group (* nonl)) eos)
(tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl)) eos)
localname)
(let ((uname (match-string 1 localname))
(fname (match-string 2 localname))
@ -518,10 +518,11 @@ the result will be a local, non-Tramp, file name."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-selinux-context"
(let ((context '(nil nil nil nil))
(regexp (rx (group (+ (any "_" alnum))) ":"
(group (+ (any "_" alnum))) ":"
(group (+ (any "_" alnum))) ":"
(group (+ (any "_" alnum))))))
(regexp (tramp-compat-rx
(group (+ (any "_" alnum))) ":"
(group (+ (any "_" alnum))) ":"
(group (+ (any "_" alnum))) ":"
(group (+ (any "_" alnum))))))
(when (and (tramp-sudoedit-remote-selinux-p v)
(tramp-sudoedit-send-command
v "ls" "-d" "-Z"

283
lisp/net/tramp.el
View file

@ -516,9 +516,10 @@ interpreted as a regular expression which always matches."
(defcustom tramp-restricted-shell-hosts-alist
(when (and (eq system-type 'windows-nt)
(not (string-match-p (rx "sh" eol) tramp-encoding-shell)))
(list (rx bos (| (literal (downcase tramp-system-name))
(literal (upcase tramp-system-name)))
eos)))
(list (tramp-compat-rx
bos (| (literal (downcase tramp-system-name))
(literal (upcase tramp-system-name)))
eos)))
"List of hosts, which run a restricted shell.
This is a list of regular expressions, which denote hosts running
a restricted shell like \"rbash\". Those hosts can be used as
@ -529,10 +530,11 @@ host runs a restricted shell, it shall be added to this list, too."
;;;###tramp-autoload
(defcustom tramp-local-host-regexp
(rx bos
(| (literal tramp-system-name)
(| "localhost" "localhost4" "localhost6" "127.0.0.1" "::1"))
eos)
(tramp-compat-rx
bos
(| (literal tramp-system-name)
(| "localhost" "localhost4" "localhost6" "127.0.0.1" "::1"))
eos)
"Host names which are regarded as local host.
If the local host runs a chrooted environment, set this to nil."
:version "29.1"
@ -629,9 +631,10 @@ This regexp must match both `tramp-initial-end-of-output' and
:type 'regexp)
(defcustom tramp-password-prompt-regexp
(rx bol (* nonl)
(group (regexp (regexp-opt password-word-equivalents)))
(* nonl) ":" (? "\^@") (* blank))
(tramp-compat-rx
bol (* nonl)
(group (regexp (regexp-opt password-word-equivalents)))
(* nonl) ":" (? "\^@") (* blank))
"Regexp matching password-like prompts.
The regexp should match at end of buffer.
@ -887,17 +890,18 @@ Used in `tramp-make-tramp-file-name'.")
(defun tramp-build-prefix-regexp ()
"Return `tramp-prefix-regexp'."
(rx bol (literal (tramp-build-prefix-format))))
(tramp-compat-rx bol (literal (tramp-build-prefix-format))))
(defvar tramp-prefix-regexp nil ; Initialized when defining `tramp-syntax'!
"Regexp matching the very beginning of Tramp file names.
Should always start with \"^\". Derived from `tramp-prefix-format'.")
(defconst tramp-method-regexp-alist
`((default . ,(rx (| (literal tramp-default-method-marker) (>= 2 alnum))))
`((default . ,(tramp-compat-rx
(| (literal tramp-default-method-marker) (>= 2 alnum))))
(simplified . "")
(separate
. ,(rx (? (| (literal tramp-default-method-marker) (>= 2 alnum))))))
(separate . ,(tramp-compat-rx
(? (| (literal tramp-default-method-marker) (>= 2 alnum))))))
"Alist mapping Tramp syntax to regexps matching methods identifiers.")
(defun tramp-build-method-regexp ()
@ -925,7 +929,7 @@ Used in `tramp-make-tramp-file-name'.")
(defun tramp-build-postfix-method-regexp ()
"Return `tramp-postfix-method-regexp'."
(rx (literal (tramp-build-postfix-method-format))))
(tramp-compat-rx (literal (tramp-build-postfix-method-format))))
(defvar tramp-postfix-method-regexp nil ; Init'd when defining `tramp-syntax'!
"Regexp matching delimiter between method and user or host names.
@ -937,7 +941,8 @@ Derived from `tramp-postfix-method-format'.")
(defconst tramp-prefix-domain-format "%"
"String matching delimiter between user and domain names.")
(defconst tramp-prefix-domain-regexp (rx (literal tramp-prefix-domain-format))
(defconst tramp-prefix-domain-regexp
(tramp-compat-rx (literal tramp-prefix-domain-format))
"Regexp matching delimiter between user and domain names.
Derived from `tramp-prefix-domain-format'.")
@ -945,16 +950,18 @@ Derived from `tramp-prefix-domain-format'.")
"Regexp matching domain names.")
(defconst tramp-user-with-domain-regexp
(rx (group (regexp tramp-user-regexp))
(regexp tramp-prefix-domain-regexp)
(group (regexp tramp-domain-regexp)))
(tramp-compat-rx
(group (regexp tramp-user-regexp))
(regexp tramp-prefix-domain-regexp)
(group (regexp tramp-domain-regexp)))
"Regexp matching user names with domain names.")
(defconst tramp-postfix-user-format "@"
"String matching delimiter between user and host names.
Used in `tramp-make-tramp-file-name'.")
(defconst tramp-postfix-user-regexp (rx (literal tramp-postfix-user-format))
(defconst tramp-postfix-user-regexp
(tramp-compat-rx (literal tramp-postfix-user-format))
"Regexp matching delimiter between user and host names.
Derived from `tramp-postfix-user-format'.")
@ -977,7 +984,7 @@ Used in `tramp-make-tramp-file-name'.")
(defun tramp-build-prefix-ipv6-regexp ()
"Return `tramp-prefix-ipv6-regexp'."
(rx (literal tramp-prefix-ipv6-format)))
(tramp-compat-rx (literal tramp-prefix-ipv6-format)))
(defvar tramp-prefix-ipv6-regexp nil ; Initialized when defining `tramp-syntax'!
"Regexp matching left hand side of IPv6 addresses.
@ -1005,7 +1012,7 @@ Used in `tramp-make-tramp-file-name'.")
(defun tramp-build-postfix-ipv6-regexp ()
"Return `tramp-postfix-ipv6-regexp'."
(rx (literal tramp-postfix-ipv6-format)))
(tramp-compat-rx (literal tramp-postfix-ipv6-format)))
(defvar tramp-postfix-ipv6-regexp nil ; Initialized when defining `tramp-syntax'!
"Regexp matching right hand side of IPv6 addresses.
@ -1014,7 +1021,8 @@ Derived from `tramp-postfix-ipv6-format'.")
(defconst tramp-prefix-port-format "#"
"String matching delimiter between host names and port numbers.")
(defconst tramp-prefix-port-regexp (rx (literal tramp-prefix-port-format))
(defconst tramp-prefix-port-regexp
(tramp-compat-rx (literal tramp-prefix-port-format))
"Regexp matching delimiter between host names and port numbers.
Derived from `tramp-prefix-port-format'.")
@ -1022,15 +1030,17 @@ Derived from `tramp-prefix-port-format'.")
"Regexp matching port numbers.")
(defconst tramp-host-with-port-regexp
(rx (group (regexp tramp-host-regexp))
(regexp tramp-prefix-port-regexp)
(group (regexp tramp-port-regexp)))
(tramp-compat-rx
(group (regexp tramp-host-regexp))
(regexp tramp-prefix-port-regexp)
(group (regexp tramp-port-regexp)))
"Regexp matching host names with port numbers.")
(defconst tramp-postfix-hop-format "|"
"String matching delimiter after ad-hoc hop definitions.")
(defconst tramp-postfix-hop-regexp (rx (literal tramp-postfix-hop-format))
(defconst tramp-postfix-hop-regexp
(tramp-compat-rx (literal tramp-postfix-hop-format))
"Regexp matching delimiter after ad-hoc hop definitions.
Derived from `tramp-postfix-hop-format'.")
@ -1050,7 +1060,7 @@ Used in `tramp-make-tramp-file-name'.")
(defun tramp-build-postfix-host-regexp ()
"Return `tramp-postfix-host-regexp'."
(rx (literal tramp-postfix-host-format)))
(tramp-compat-rx (literal tramp-postfix-host-format)))
(defvar tramp-postfix-host-regexp nil ; Initialized when defining `tramp-syntax'!
"Regexp matching delimiter between host names and localnames.
@ -1077,17 +1087,18 @@ Derived from `tramp-postfix-host-format'.")
(defun tramp-build-remote-file-name-spec-regexp ()
"Construct a regexp matching a Tramp file name for a Tramp syntax.
It is expected, that `tramp-syntax' has the proper value."
(rx ;; Method.
(group (regexp tramp-method-regexp)) (regexp tramp-postfix-method-regexp)
;; Optional user.
(? (group (regexp tramp-user-regexp)) (regexp tramp-postfix-user-regexp))
;; Optional host.
(? (group (| (regexp tramp-host-regexp)
(: (regexp tramp-prefix-ipv6-regexp)
(? (regexp tramp-ipv6-regexp))
(regexp tramp-postfix-ipv6-regexp)))
;; Optional port.
(? (regexp tramp-prefix-port-regexp) (regexp tramp-port-regexp))))))
(tramp-compat-rx
;; Method.
(group (regexp tramp-method-regexp)) (regexp tramp-postfix-method-regexp)
;; Optional user. This includes domain.
(? (group (regexp tramp-user-regexp)) (regexp tramp-postfix-user-regexp))
;; Optional host.
(? (group (| (regexp tramp-host-regexp)
(: (regexp tramp-prefix-ipv6-regexp)
(? (regexp tramp-ipv6-regexp))
(regexp tramp-postfix-ipv6-regexp)))
;; Optional port.
(? (regexp tramp-prefix-port-regexp) (regexp tramp-port-regexp))))))
(defvar tramp-remote-file-name-spec-regexp
nil ; Initialized when defining `tramp-syntax'!
@ -1098,12 +1109,13 @@ It is expected, that `tramp-syntax' has the proper value."
It is expected, that `tramp-syntax' has the proper value.
See `tramp-file-name-structure'."
(list
(rx (regexp tramp-prefix-regexp)
(? (group (+ (regexp tramp-remote-file-name-spec-regexp)
(regexp tramp-postfix-hop-regexp))))
(regexp tramp-remote-file-name-spec-regexp)
(regexp tramp-postfix-host-regexp)
(group (regexp tramp-localname-regexp)))
(tramp-compat-rx
(regexp tramp-prefix-regexp)
(? (group (+ (regexp tramp-remote-file-name-spec-regexp)
(regexp tramp-postfix-hop-regexp))))
(regexp tramp-remote-file-name-spec-regexp)
(regexp tramp-postfix-host-regexp)
(group (regexp tramp-localname-regexp)))
5 6 7 8 1))
(defvar tramp-file-name-structure nil ; Initialized when defining `tramp-syntax'!
@ -1157,9 +1169,11 @@ initial value is overwritten by the car of `tramp-file-name-structure'.")
;; `tramp-method-regexp' needs at least two characters, in order to
;; distinguish from volume letter. This is in the way when completing.
(defconst tramp-completion-method-regexp-alist
`((default . ,(rx (| (literal tramp-default-method-marker) (+ alnum))))
`((default . ,(tramp-compat-rx
(| (literal tramp-default-method-marker) (+ alnum))))
(simplified . "")
(separate . ,(rx (| (literal tramp-default-method-marker) (* alnum)))))
(separate . ,(tramp-compat-rx
(| (literal tramp-default-method-marker) (* alnum)))))
"Alist mapping Tramp syntax to regexps matching completion methods.")
(defun tramp-build-completion-method-regexp ()
@ -1175,27 +1189,28 @@ The `ftp' syntax does not support methods.")
"Return `tramp-completion-file-name-regexp' according to `tramp-syntax'."
(if (eq tramp-syntax 'separate)
;; FIXME: This shouldn't be necessary.
(rx bos "/" (? "[" (* (not (any "]")))) eos)
(rx bos
;; `file-name-completion' uses absolute paths for matching.
;; This means that on W32 systems, something like
;; "/ssh:host:~/path" becomes "c:/ssh:host:~/path". See also
;; `tramp-drop-volume-letter'.
(? (regexp tramp-volume-letter-regexp))
(regexp tramp-prefix-regexp)
(tramp-compat-rx bos "/" (? "[" (* (not "]"))) eos)
(tramp-compat-rx
bos
;; `file-name-completion' uses absolute paths for matching.
;; This means that on W32 systems, something like
;; "/ssh:host:~/path" becomes "c:/ssh:host:~/path". See also
;; `tramp-drop-volume-letter'.
(? (regexp tramp-volume-letter-regexp))
(regexp tramp-prefix-regexp)
;; Optional multi hops.
(* (regexp tramp-remote-file-name-spec-regexp)
(regexp tramp-postfix-hop-regexp))
;; Optional multi hops.
(* (regexp tramp-remote-file-name-spec-regexp)
(regexp tramp-postfix-hop-regexp))
;; Last hop.
(? (regexp tramp-completion-method-regexp)
;; Method separator, user name and host name.
(? (regexp tramp-postfix-method-regexp)
;; This is a little bit lax, but it serves.
(? (regexp tramp-host-regexp))))
;; Last hop.
(? (regexp tramp-completion-method-regexp)
;; Method separator, user name and host name.
(? (regexp tramp-postfix-method-regexp)
;; This is a little bit lax, but it serves.
(? (regexp tramp-host-regexp))))
eos)))
eos)))
(defvar tramp-completion-file-name-regexp
nil ; Initialized when defining `tramp-syntax'!
@ -1733,7 +1748,7 @@ See `tramp-dissect-file-name' for details."
(let ((v (tramp-dissect-file-name
(concat tramp-prefix-format
(replace-regexp-in-string
(rx (regexp tramp-postfix-hop-regexp) eos)
(tramp-compat-rx (regexp tramp-postfix-hop-regexp) eos)
tramp-postfix-host-format name))
nodefault)))
;; Only some methods from tramp-sh.el do support multi-hops.
@ -1829,7 +1844,8 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)."
(replace-regexp-in-string
tramp-prefix-regexp ""
(replace-regexp-in-string
(rx (regexp tramp-postfix-host-regexp) eos) tramp-postfix-hop-format
(tramp-compat-rx
(regexp tramp-postfix-host-regexp) eos) tramp-postfix-hop-format
(tramp-make-tramp-file-name vec 'noloc)))))
(defun tramp-completion-make-tramp-file-name (method user host localname)
@ -1958,7 +1974,7 @@ of `current-buffer'."
;; Also, in `font-lock-defaults' you can specify a function name for
;; the "KEYWORDS" part, so font-lock calls it to get the actual keywords!
'(list
(rx bol (regexp tramp-debug-outline-regexp) (+ nonl))
(tramp-compat-rx bol (regexp tramp-debug-outline-regexp) (+ nonl))
'(1 font-lock-warning-face t t)
'(0 (outline-font-lock-face) keep t))
"Used for highlighting Tramp debug buffers in `outline-mode'.")
@ -2413,9 +2429,9 @@ letter into the file name. This function removes it."
(let ((quoted (tramp-compat-file-name-quoted-p name 'top))
(result (tramp-compat-file-name-unquote name 'top)))
(setq result
(if (string-match
(rx (regexp tramp-volume-letter-regexp) "/") result)
(replace-match "/" nil t result) result))
(replace-regexp-in-string
(tramp-compat-rx (regexp tramp-volume-letter-regexp) "/")
"/" result))
(if quoted (tramp-compat-file-name-quote result 'top) result))))
;;; Config Manipulation Functions:
@ -2524,7 +2540,7 @@ coding system might not be determined. This function repairs it."
;; We found a matching entry in `file-coding-system-alist'.
;; So we add a similar entry, but with the temporary file name
;; as regexp.
(push (cons (rx (literal tmpname)) (cdr elt)) result)))))
(push (cons (tramp-compat-rx (literal tmpname)) (cdr elt)) result)))))
(defun tramp-run-real-handler (operation args)
"Invoke normal file name handler for OPERATION.
@ -2807,7 +2823,7 @@ remote file names."
#'file-name-sans-extension
(directory-files
dir nil (rx bos "tramp" (+ nonl) ".el" (? "c") eos)))))
(files-regexp (rx bol (regexp (regexp-opt files)) eol)))
(files-regexp (tramp-compat-rx bol (regexp (regexp-opt files)) eol)))
(mapatoms
(lambda (atom)
(when (and (functionp atom)
@ -2952,9 +2968,10 @@ not in completion mode."
;; Suppress hop from completion.
(when (string-match
(rx (regexp tramp-prefix-regexp)
(group (+ (regexp tramp-remote-file-name-spec-regexp)
(regexp tramp-postfix-hop-regexp))))
(tramp-compat-rx
(regexp tramp-prefix-regexp)
(group (+ (regexp tramp-remote-file-name-spec-regexp)
(regexp tramp-postfix-hop-regexp))))
fullname)
(setq hop (match-string 1 fullname)
fullname (replace-match "" nil nil fullname 1)))
@ -3044,54 +3061,60 @@ They are collected by `tramp-completion-dissect-file-name1'."
(let (;; "/method" "/[method"
(tramp-completion-file-name-structure1
(list
(rx (regexp tramp-prefix-regexp)
(group (? (regexp tramp-completion-method-regexp))) eol)
(tramp-compat-rx
(regexp tramp-prefix-regexp)
(group (? (regexp tramp-completion-method-regexp))) eol)
1 nil nil nil))
;; "/method:user" "/[method/user"
(tramp-completion-file-name-structure2
(list
(rx (regexp tramp-prefix-regexp)
(group (regexp tramp-method-regexp))
(regexp tramp-postfix-method-regexp)
(group (? (regexp tramp-user-regexp))) eol)
(tramp-compat-rx
(regexp tramp-prefix-regexp)
(group (regexp tramp-method-regexp))
(regexp tramp-postfix-method-regexp)
(group (? (regexp tramp-user-regexp))) eol)
1 2 nil nil))
;; "/method:host" "/[method/host"
(tramp-completion-file-name-structure3
(list
(rx (regexp tramp-prefix-regexp)
(group (regexp tramp-method-regexp))
(regexp tramp-postfix-method-regexp)
(group (? (regexp tramp-host-regexp))) eol)
(tramp-compat-rx
(regexp tramp-prefix-regexp)
(group (regexp tramp-method-regexp))
(regexp tramp-postfix-method-regexp)
(group (? (regexp tramp-host-regexp))) eol)
1 nil 2 nil))
;; "/method:[ipv6" "/[method/ipv6"
(tramp-completion-file-name-structure4
(list
(rx (regexp tramp-prefix-regexp)
(group (regexp tramp-method-regexp))
(regexp tramp-postfix-method-regexp)
(regexp tramp-prefix-ipv6-regexp)
(group (? (regexp tramp-ipv6-regexp))) eol)
(tramp-compat-rx
(regexp tramp-prefix-regexp)
(group (regexp tramp-method-regexp))
(regexp tramp-postfix-method-regexp)
(regexp tramp-prefix-ipv6-regexp)
(group (? (regexp tramp-ipv6-regexp))) eol)
1 nil 2 nil))
;; "/method:user@host" "/[method/user@host"
(tramp-completion-file-name-structure5
(list
(rx (regexp tramp-prefix-regexp)
(group (regexp tramp-method-regexp))
(regexp tramp-postfix-method-regexp)
(group (regexp tramp-user-regexp))
(regexp tramp-postfix-user-regexp)
(group (? (regexp tramp-host-regexp))) eol)
(tramp-compat-rx
(regexp tramp-prefix-regexp)
(group (regexp tramp-method-regexp))
(regexp tramp-postfix-method-regexp)
(group (regexp tramp-user-regexp))
(regexp tramp-postfix-user-regexp)
(group (? (regexp tramp-host-regexp))) eol)
1 2 3 nil))
;; "/method:user@[ipv6" "/[method/user@ipv6"
(tramp-completion-file-name-structure6
(list
(rx (regexp tramp-prefix-regexp)
(group (regexp tramp-method-regexp))
(regexp tramp-postfix-method-regexp)
(group (regexp tramp-user-regexp))
(regexp tramp-postfix-user-regexp)
(regexp tramp-prefix-ipv6-regexp)
(group (? (regexp tramp-ipv6-regexp))) eol)
(tramp-compat-rx
(regexp tramp-prefix-regexp)
(group (regexp tramp-method-regexp))
(regexp tramp-postfix-method-regexp)
(group (regexp tramp-user-regexp))
(regexp tramp-postfix-user-regexp)
(regexp tramp-prefix-ipv6-regexp)
(group (? (regexp tramp-ipv6-regexp))) eol)
1 2 3 nil)))
(delq
nil
@ -3217,8 +3240,9 @@ Either user or host may be nil."
Either user or host may be nil."
(let (result
(regexp
(rx bol (group (regexp tramp-host-regexp))
(? (+ blank) (group (regexp tramp-user-regexp))))))
(tramp-compat-rx
bol (group (regexp tramp-host-regexp))
(? (+ blank) (group (regexp tramp-user-regexp))))))
(when (re-search-forward regexp (line-end-position) t)
(setq result (append (list (match-string 2) (match-string 1)))))
(forward-line 1)
@ -3232,7 +3256,8 @@ User is always nil."
(defun tramp-parse-shosts-group ()
"Return a (user host) tuple allowed to access.
User is always nil."
(tramp-parse-group (rx bol (group (regexp tramp-host-regexp))) 1 ","))
(tramp-parse-group
(tramp-compat-rx bol (group (regexp tramp-host-regexp))) 1 ","))
(defun tramp-parse-sconfig (filename)
"Return a list of (user host) tuples allowed to access.
@ -3243,9 +3268,10 @@ User is always nil."
"Return a (user host) tuple allowed to access.
User is always nil."
(tramp-parse-group
(rx (| (: bol (* blank) "Host")
(: bol (+ nonl)) ;; ???
(group (regexp tramp-host-regexp))))
(tramp-compat-rx
(| (: bol (* blank) "Host")
(: bol (+ nonl)) ;; ???
(group (regexp tramp-host-regexp))))
1 (rx blank)))
;; Generic function.
@ -3267,15 +3293,16 @@ User is always nil."
User is always nil."
(tramp-parse-shostkeys-sknownhosts
dirname
(rx bol "key_" (+ digit) "_" (group (regexp tramp-host-regexp)) ".pub" eol)))
(tramp-compat-rx
bol "key_" (+ digit) "_" (group (regexp tramp-host-regexp)) ".pub" eol)))
(defun tramp-parse-sknownhosts (dirname)
"Return a list of (user host) tuples allowed to access.
User is always nil."
(tramp-parse-shostkeys-sknownhosts
dirname
(rx bol (group (regexp tramp-host-regexp))
".ssh-" (| "dss" "rsa") ".pub" eol)))
(tramp-compat-rx
bol (group (regexp tramp-host-regexp)) ".ssh-" (| "dss" "rsa") ".pub" eol)))
(defun tramp-parse-hosts (filename)
"Return a list of (user host) tuples allowed to access.
@ -3286,7 +3313,8 @@ User is always nil."
"Return a (user host) tuple allowed to access.
User is always nil."
(tramp-parse-group
(rx bol (group (| (regexp tramp-ipv6-regexp) (regexp tramp-host-regexp))))
(tramp-compat-rx
bol (group (| (regexp tramp-ipv6-regexp) (regexp tramp-host-regexp))))
1 (rx blank)))
(defun tramp-parse-passwd (filename)
@ -3305,7 +3333,7 @@ Host is always \"localhost\"."
"Return a (user host) tuple allowed to access.
Host is always \"localhost\"."
(let (result
(regexp (rx bol (group (regexp tramp-user-regexp)) ":")))
(regexp (tramp-compat-rx bol (group (regexp tramp-user-regexp)) ":")))
(when (re-search-forward regexp (line-end-position) t)
(setq result (list (match-string 1) "localhost")))
(forward-line 1)
@ -3356,13 +3384,14 @@ User is always nil."
(tramp-parse-putty-group registry-or-dirname)))))
;; UNIX case.
(tramp-parse-shostkeys-sknownhosts
registry-or-dirname (rx bol (group (regexp tramp-host-regexp)) eol))))
registry-or-dirname
(tramp-compat-rx bol (group (regexp tramp-host-regexp)) eol))))
(defun tramp-parse-putty-group (registry)
"Return a (user host) tuple allowed to access.
User is always nil."
(let (result
(regexp (rx (literal registry) "\\" (group (+ nonl)))))
(regexp (tramp-compat-rx (literal registry) "\\" (group (+ nonl)))))
(when (re-search-forward regexp (line-end-position) t)
(setq result (list nil (match-string 1))))
(forward-line 1)
@ -3763,7 +3792,7 @@ Let-bind it when necessary.")
;; not support tilde expansion. But users could declare a
;; respective connection property. (Bug#53847)
(when (string-match
(rx bos "~" (group (* (not (any "/")))) (group (* nonl)) eos)
(tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl)) eos)
localname)
(let ((uname (match-string 1 localname))
(fname (match-string 2 localname))
@ -3927,7 +3956,8 @@ Let-bind it when necessary.")
(and
completion-ignored-extensions
(string-match-p
(rx (regexp (regexp-opt completion-ignored-extensions)) eos)
(tramp-compat-rx
(regexp (regexp-opt completion-ignored-extensions)) eos)
x)
;; We remember the hit.
(push x hits-ignored-extensions))))))
@ -4570,9 +4600,9 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.")
tramp-prefix-format proxy tramp-postfix-host-format))
(entry
(list (and (stringp host-port)
(rx bol (literal host-port) eol))
(tramp-compat-rx bol (literal host-port) eol))
(and (stringp user-domain)
(rx bol (literal user-domain) eol))
(tramp-compat-rx bol (literal user-domain) eol))
(propertize proxy 'tramp-ad-hoc t))))
(tramp-message vec 5 "Add %S to `tramp-default-proxies-alist'" entry)
;; Add the hop.
@ -4651,7 +4681,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.")
(setq tramp-default-proxies-alist saved-tdpa)
(tramp-user-error
vec "Host name `%s' does not match `%s'" host previous-host))
(setq previous-host (rx bol (literal host) eol)))))
(setq previous-host (tramp-compat-rx bol (literal host) eol)))))
;; Result.
target-alist))
@ -5614,7 +5644,8 @@ the remote host use line-endings as defined in the variable
(tramp-flush-directory-properties vec "/"))
(when (buffer-live-p buf)
(with-current-buffer buf
(when (and prompt (tramp-search-regexp (rx (literal prompt))))
(when (and prompt
(tramp-search-regexp (tramp-compat-rx (literal prompt))))
(delete-region (point) (point-max))))))))
(defun tramp-get-inode (vec)
@ -5818,7 +5849,7 @@ VEC is used for tracing."
(while candidates
(goto-char (point-min))
(if (string-match-p
(rx bol (literal (car candidates)) (? "\r") eol)
(tramp-compat-rx bol (literal (car candidates)) (? "\r") eol)
(buffer-string))
(setq locale (car candidates)
candidates nil)
@ -6178,7 +6209,7 @@ ALIST is of the form ((FROM . TO) ...)."
(let* ((pr (car alist))
(from (car pr))
(to (cdr pr)))
(while (string-match (rx (literal from)) string)
(while (string-match (tramp-compat-rx (literal from)) string)
(setq string (replace-match to t t string)))
(setq alist (cdr alist))))
string))
@ -6446,7 +6477,7 @@ Only works for Bourne-like shells."
(string= (substring result 0 2) "\\~"))
(setq result (substring result 1)))
(replace-regexp-in-string
(rx "\\" (literal tramp-rsh-end-of-line))
(tramp-compat-rx "\\" (literal tramp-rsh-end-of-line))
(format "'%s'" tramp-rsh-end-of-line) result)))))
;;; Signal handling. This works for remote processes, which have set

30
test/lisp/net/tramp-archive-tests.el
View file

@ -616,13 +616,15 @@ This checks also `file-name-as-directory', `file-name-directory',
(insert-directory tramp-archive-test-archive nil)
(goto-char (point-min))
(should
(looking-at-p (rx (literal tramp-archive-test-archive)))))
(looking-at-p
(tramp-compat-rx (literal tramp-archive-test-archive)))))
(with-temp-buffer
(insert-directory tramp-archive-test-archive "-al")
(goto-char (point-min))
(should
(looking-at-p
(rx bol (+ nonl) blank (literal tramp-archive-test-archive) eol))))
(tramp-compat-rx
bol (+ nonl) blank (literal tramp-archive-test-archive) eol))))
(with-temp-buffer
(insert-directory
(file-name-as-directory tramp-archive-test-archive)
@ -917,14 +919,15 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(dolist (file `("/mock::foo" ,(concat tramp-archive-test-archive "foo")))
(should
(string-match
(rx "tramp-archive loaded: "
(literal (symbol-name
(tramp-archive-file-name-p default-directory)))
(+ ascii)
"tramp-archive loaded: "
(literal (symbol-name
(or (tramp-archive-file-name-p default-directory)
(and enabled (tramp-archive-file-name-p file))))))
(tramp-compat-rx
"tramp-archive loaded: "
(literal (symbol-name
(tramp-archive-file-name-p default-directory)))
(+ ascii)
"tramp-archive loaded: "
(literal (symbol-name
(or (tramp-archive-file-name-p default-directory)
(and enabled (tramp-archive-file-name-p file))))))
(shell-command-to-string
(format
"%s -batch -Q -L %s --eval %s --eval %s"
@ -961,9 +964,10 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(dolist (tae '(t nil))
(should
(string-match
(rx "tramp-archive loaded: nil" (+ ascii)
"tramp-archive loaded: nil" (+ ascii)
"tramp-archive loaded: " (literal (symbol-name tae)))
(tramp-compat-rx
"tramp-archive loaded: nil" (+ ascii)
"tramp-archive loaded: nil" (+ ascii)
"tramp-archive loaded: " (literal (symbol-name tae)))
(shell-command-to-string
(format
"%s -batch -Q -L %s --eval %s"

104
test/lisp/net/tramp-tests.el
View file

@ -2295,9 +2295,9 @@ This checks also `file-name-as-directory', `file-name-directory',
;; Check `directory-abbrev-alist' abbreviation.
(let ((directory-abbrev-alist
`((,(rx bos (literal home-dir) "/foo")
`((,(tramp-compat-rx bos (literal home-dir) "/foo")
. ,(concat home-dir "/f"))
(,(rx bos (literal remote-host) "/nowhere")
(,(tramp-compat-rx bos (literal remote-host) "/nowhere")
. ,(concat remote-host "/nw")))))
(should (equal (abbreviate-file-name (concat home-dir "/foo/bar"))
(concat remote-host-nohop "~/f/bar")))
@ -2510,7 +2510,8 @@ This checks also `file-name-as-directory', `file-name-directory',
(string-match-p
(if (and (null noninteractive)
(or (eq visit t) (null visit) (stringp visit)))
(rx bol "Wrote " (literal tmp-name) "\n" eos)
(tramp-compat-rx
bol "Wrote " (literal tmp-name) "\n" eos)
(rx bos))
tramp--test-messages))))))
@ -3211,24 +3212,26 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(with-temp-buffer
(insert-directory tmp-name1 nil)
(goto-char (point-min))
(should (looking-at-p (rx (literal tmp-name1)))))
(should (looking-at-p (tramp-compat-rx (literal tmp-name1)))))
(with-temp-buffer
(insert-directory (file-name-as-directory tmp-name1) nil)
(goto-char (point-min))
(should
(looking-at-p
(rx (literal (file-name-as-directory tmp-name1))))))
(tramp-compat-rx (literal (file-name-as-directory tmp-name1))))))
(with-temp-buffer
(insert-directory tmp-name1 "-al")
(goto-char (point-min))
(should
(looking-at-p (rx bol (+ nonl) blank (literal tmp-name1) eol))))
(looking-at-p
(tramp-compat-rx bol (+ nonl) blank (literal tmp-name1) eol))))
(with-temp-buffer
(insert-directory (file-name-as-directory tmp-name1) "-al")
(goto-char (point-min))
(should
(looking-at-p
(rx bol (+ nonl) blank (literal tmp-name1) "/" eol))))
(tramp-compat-rx
bol (+ nonl) blank (literal tmp-name1) "/" eol))))
(with-temp-buffer
(insert-directory
(file-name-as-directory tmp-name1) "-al" nil 'full-directory-p)
@ -3312,15 +3315,17 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(goto-char (point-min))
(should
(re-search-forward
(rx (literal
(file-relative-name
tmp-name1 ert-remote-temporary-file-directory)))))
(tramp-compat-rx
(literal
(file-relative-name
tmp-name1 ert-remote-temporary-file-directory)))))
(goto-char (point-min))
(should
(re-search-forward
(rx (literal
(file-relative-name
tmp-name2 ert-remote-temporary-file-directory))))))
(tramp-compat-rx
(literal
(file-relative-name
tmp-name2 ert-remote-temporary-file-directory))))))
(kill-buffer buffer)
;; Check for expanded directory and file names.
@ -3332,16 +3337,18 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(goto-char (point-min))
(should
(re-search-forward
(rx (literal
(file-relative-name
tmp-name3 ert-remote-temporary-file-directory)))))
(tramp-compat-rx
(literal
(file-relative-name
tmp-name3 ert-remote-temporary-file-directory)))))
(goto-char (point-min))
(should
(re-search-forward
(rx (literal
(file-relative-name
tmp-name4
ert-remote-temporary-file-directory))))))
(tramp-compat-rx
(literal
(file-relative-name
tmp-name4
ert-remote-temporary-file-directory))))))
(kill-buffer buffer)
;; Check for special characters.
@ -3360,16 +3367,18 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(goto-char (point-min))
(should
(re-search-forward
(rx (literal
(file-relative-name
tmp-name3 ert-remote-temporary-file-directory)))))
(tramp-compat-rx
(literal
(file-relative-name
tmp-name3 ert-remote-temporary-file-directory)))))
(goto-char (point-min))
(should
(re-search-forward
(rx (literal
(file-relative-name
tmp-name4
ert-remote-temporary-file-directory))))))
(tramp-compat-rx
(literal
(file-relative-name
tmp-name4
ert-remote-temporary-file-directory))))))
(kill-buffer buffer))
;; Cleanup.
@ -3599,6 +3608,9 @@ This tests also `access-file', `file-readable-p',
(cons '(nil "perl" nil)
tramp-connection-properties)))
(progn
;; `ert-test-result-duration' exists since Emacs 27. It
;; doesn't hurt to call it unconditionally, because
;; `skip-unless' hides the error.
(skip-unless (< (ert-test-result-duration result) 300))
(funcall (ert-test-body ert-test)))
(ert-skip (format "Test `%s' must run before" ',test)))))
@ -3627,6 +3639,9 @@ This tests also `access-file', `file-readable-p',
(nil "id" nil))
tramp-connection-properties)))
(progn
;; `ert-test-result-duration' exists since Emacs 27. It
;; doesn't hurt to call it unconditionally, because
;; `skip-unless' hides the error.
(skip-unless (< (ert-test-result-duration result) 300))
(funcall (ert-test-body ert-test)))
(ert-skip (format "Test `%s' must run before" ',test)))))
@ -3653,6 +3668,9 @@ This tests also `access-file', `file-readable-p',
(nil "readlink" nil))
tramp-connection-properties)))
(progn
;; `ert-test-result-duration' exists since Emacs 27. It
;; doesn't hurt to call it unconditionally, because
;; `skip-unless' hides the error.
(skip-unless (< (ert-test-result-duration result) 300))
(funcall (ert-test-body ert-test)))
(ert-skip (format "Test `%s' must run before" ',test)))))
@ -5679,7 +5697,7 @@ INPUT, if non-nil, is a string sent to the process."
;; Variable is set.
(should
(string-match-p
(rx (literal envvar))
(tramp-compat-rx (literal envvar))
(funcall this-shell-command-to-string "set"))))
(unless (tramp-direct-async-process-p)
@ -5706,7 +5724,7 @@ INPUT, if non-nil, is a string sent to the process."
;; Variable is unset.
(should-not
(string-match-p
(rx (literal envvar))
(tramp-compat-rx (literal envvar))
;; We must remove PS1, the output is truncated otherwise.
;; We must suppress "_=VAR...".
(funcall
@ -6598,7 +6616,7 @@ This is used in tests which we don't want to tag
:body nil :tags '(:tramp-asynchronous-processes))))
;; tramp-adb.el cannot apply multi-byte commands.
(not (and (tramp--test-adb-p)
(string-match-p (rx multibyte) default-directory)))))
(string-match-p (tramp-compat-rx multibyte) default-directory)))))
(defun tramp--test-crypt-p ()
"Check, whether the remote directory is encrypted."
@ -6906,14 +6924,14 @@ This requires restrictions of file name syntax."
(should
(string-equal
(caar (directory-files-and-attributes
file1 nil (rx (literal elt1))))
file1 nil (tramp-compat-rx (literal elt1))))
elt1))
(should
(string-equal
(funcall
(if quoted #'tramp-compat-file-name-quote #'identity)
(cadr (car (directory-files-and-attributes
file1 nil (rx (literal elt1))))))
file1 nil (tramp-compat-rx (literal elt1))))))
(file-remote-p (file-truename file2) 'localname)))
(delete-file file3)
(should-not (file-exists-p file3))))
@ -6968,8 +6986,9 @@ This requires restrictions of file name syntax."
(goto-char (point-min))
(should
(re-search-forward
(rx bol (literal envvar)
"=" (literal (getenv envvar)) eol))))))))
(tramp-compat-rx
bol (literal envvar)
"=" (literal (getenv envvar)) eol))))))))
;; Cleanup.
(ignore-errors (kill-buffer buffer))
@ -7511,9 +7530,10 @@ process sentinels. They shall not disturb each other."
(dolist (tm '(t nil))
(should
(string-match-p
(rx "Tramp loaded: nil" (+ (any "\n\r"))
"Tramp loaded: nil" (+ (any "\n\r"))
"Tramp loaded: " (literal (symbol-name tm)) (+ (any "\n\r")))
(tramp-compat-rx
"Tramp loaded: nil" (+ (any "\n\r"))
"Tramp loaded: nil" (+ (any "\n\r"))
"Tramp loaded: " (literal (symbol-name tm)) (+ (any "\n\r")))
(shell-command-to-string
(format
"%s -batch -Q -L %s --eval %s"
@ -7558,10 +7578,11 @@ process sentinels. They shall not disturb each other."
(tramp-cleanup-all-connections))"))
(should
(string-match-p
(rx "Loading "
(literal
(expand-file-name
"tramp-cmds" (file-name-directory (locate-library "tramp")))))
(tramp-compat-rx
"Loading "
(literal
(expand-file-name
"tramp-cmds" (file-name-directory (locate-library "tramp")))))
(shell-command-to-string
(format
"%s -batch -Q -L %s -l tramp-sh --eval %s"
@ -7665,6 +7686,7 @@ If INTERACTIVE is non-nil, the tests are run interactively."
;; * file-in-directory-p
;; * file-name-case-insensitive-p
;; * tramp-get-remote-gid
;; * tramp-get-remote-groups
;; * tramp-get-remote-uid
;; * tramp-set-file-uid-gid