mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-28 19:42:02 +00:00
Code Issues Releases Activity

Fix rx forms in Tramp

Browse Source 
* lisp/net/tramp.el (tramp-restricted-shell-hosts-alist)
(tramp-local-host-regexp, tramp-echoed-echo-mark-regexp)
(tramp-login-prompt-regexp, tramp-terminal-prompt-regexp)
(tramp-antispoof-regexp)
(tramp-build-completion-file-name-regexp)
(tramp-debug-outline-regexp)
(tramp-use-absolute-autoload-file-names)
(tramp-lock-file-info-regexp, tramp-shell-quote-argument):
* lisp/net/tramp-adb.el (tramp-do-parse-file-attributes-with-ls)
* lisp/net/tramp-cache.el (tramp-flush-file-function):
* lisp/net/tramp-gvfs.el (tramp-gvfs-file-name):
* lisp/net/tramp-integration.el (tramp-rfn-eshadow-update-overlay-regexp)
(info-lookup-maybe-add-help):
* lisp/net/tramp-sh.el (tramp-default-user-alist, tramp-sunos-unames)
(tramp-scp-direct-remote-copying, tramp-get-remote-locale):
* lisp/net/tramp-smb.el (tramp-smb-prompt, tramp-smb-wrong-passwd-regexp)
(tramp-smb-errors, tramp-smb-get-localname)
(tramp-smb-read-file-entry): Simplify rx forms.

* lisp/net/tramp.el (tramp-handle-find-backup-file-name)
(tramp-handle-lock-file, tramp-handle-make-auto-save-file-name):
* lisp/net/tramp-adb.el (tramp-adb-handle-set-file-times)
(tramp-adb-maybe-open-connection):
* lisp/net/tramp-gvfs.el
(tramp-gvfs-file-attributes-with-gvfs-ls-regexp):
* lisp/net/tramp-sh.el (tramp-open-shell, tramp-find-shell): Do not use
`eval-when-compile'.

* lisp/net/tramp-cmds.el (tramp-rename-files, tramp-rename-these-files):
Use rx.

* lisp/net/tramp-gvfs.el (tramp-gvfs-password-tcrypt): New defonst.
(tramp-gvfs-handle-file-attributes): Use `number-to-string'.

* test/lisp/net/tramp-archive-tests.el
(tramp-archive-test17-insert-directory):
* test/lisp/net/tramp-tests.el (tramp-test17-insert-directory)
(tramp--test-share-p): Simplify rx forms.
This commit is contained in:
Michael Albinus 2022-09-04 13:44:30 +02:00
parent 4751b51d5e
commit f1635c8efb
11 changed files with 195 additions and 206 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
lisp/net/tramp-adb.el
View File

@ -278,10 +278,10 @@ arguments to pass to the OPERATION."
(name (match-string 6))
(symlink-target
(and is-symlink
(cadr (split-string name (rx (group (| " -> " "\n"))))))))
(cadr (split-string name (rx (| " -> " "\n")))))))
(push (list
(if is-symlink
(car (split-string name (rx (group (| " -> " "\n")))))
(car (split-string name (rx (| " -> " "\n"))))
name)
(or is-dir symlink-target)
1 ;link-count
@ -560,10 +560,9 @@ Emacs dired can't find files."
;; (introduced in POSIX.1-2008) fails.
(tramp-adb-send-command-and-check
v (format
(eval-when-compile
(concat "touch -d %s %s %s 2>%s || "
"touch -d %s %s %s 2>%s || "
"touch -t %s %s %s"))
(concat "touch -d %s %s %s 2>%s || "
"touch -d %s %s %s 2>%s || "
"touch -t %s %s %s")
(format-time-string "%Y-%m-%dT%H:%M:%S.%NZ" time t)
nofollow quoted-name (tramp-get-remote-null-device v)
(format-time-string "%Y-%m-%dT%H:%M:%S" time t)
@ -1284,11 +1283,10 @@ connection if a previous connection has died for some reason."
(tramp-message vec 5 "Checking system information")
(tramp-adb-send-command
vec
(eval-when-compile
(concat
"echo \\\"`getprop ro.product.model` "
"`getprop ro.product.version` "
"`getprop ro.build.version.release`\\\"")))
(concat
"echo \\\"`getprop ro.product.model` "
"`getprop ro.product.version` "
"`getprop ro.build.version.release`\\\""))
(let ((old-getprop (tramp-get-connection-property vec "getprop"))
(new-getprop
(tramp-set-connection-property

4
lisp/net/tramp-archive.el
View File

@ -185,14 +185,14 @@ It must be supported by libarchive(3).")
(progn (defmacro tramp-archive-autoload-file-name-regexp ()
"Regular expression matching archive file names."
'(rx bos
;; \1
;; 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))))
;; \2
;; This group is used in `tramp-archive-file-name-localname'.
(group "/" (* nonl))
eos)))

2
lisp/net/tramp-cache.el
View File

@ -278,7 +278,7 @@ Remove also properties of all files in subdirectories."
This is suppressed for temporary buffers."
(save-match-data
(unless (or (null (buffer-name))
(string-match-p (rx bos (| " " "*")) (buffer-name)))
(string-match-p (rx bos (| space "*")) (buffer-name)))
(let ((bfn (if (stringp (buffer-file-name))
(buffer-file-name)
default-directory))

4
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
(regexp-quote (file-remote-p source))))
(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
(regexp-quote (file-remote-p source))))
(rx (literal (file-remote-p source)))))
(read-file-name-default
(format "Change Tramp connection `%s': " source)
dir default 'confirm init #'file-directory-p)))))

19
lisp/net/tramp-gvfs.el
View File

@ -316,6 +316,10 @@ It has been changed in GVFS 1.14.")
(defconst tramp-gvfs-password-anonymous-supported 16
"Operation supports anonymous users.")
;; Since: 2.58
(defconst tramp-gvfs-password-tcrypt 32
"Operation takes TCRYPT parameters.")
;; For the time being, we just need org.goa.Account and org.goa.Files
;; interfaces. We document the other ones, just in case.
@ -710,11 +714,10 @@ It has been changed in GVFS 1.14.")
"unix::device")
"GVFS file attributes."))
(eval-and-compile
(defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp
(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-ls-regexp
(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)))
@ -1317,7 +1320,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(if (eq id-format 'integer)
(string-to-number
(or (cdr (assoc "unix::uid" attributes))
(eval-when-compile (format "%s" tramp-unknown-id-integer))))
(number-to-string tramp-unknown-id-integer)))
(or (cdr (assoc "owner::user" attributes))
(cdr (assoc "unix::uid" attributes))
tramp-unknown-id-string)))
@ -1325,7 +1328,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(if (eq id-format 'integer)
(string-to-number
(or (cdr (assoc "unix::gid" attributes))
(eval-when-compile (format "%s" tramp-unknown-id-integer))))
(number-to-string tramp-unknown-id-integer)))
(or (cdr (assoc "owner::group" attributes))
(cdr (assoc "unix::gid" attributes))
tramp-unknown-id-string)))
@ -1726,7 +1729,7 @@ 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) "/" (+ (not (any "/"))) eol) "\\1" object-path)))
(rx bol (* nonl) "/" (group (+ (not (any "/")))) eol) "\\1" object-path)))
(defun tramp-gvfs-url-host (url)
"Return the host name part of URL, a string.

10
lisp/net/tramp-integration.el
View File

@ -86,7 +86,7 @@ special handling of `substitute-in-file-name'."
(defun tramp-rfn-eshadow-update-overlay-regexp ()
"An overlay covering the shadowed part of the filename."
(rx-to-string
`(: (* (not (any ,tramp-postfix-host-format "/~"))) (or "/" "~"))))
`(: (* (not (any ,tramp-postfix-host-format "/~"))) (| "/" "~"))))
(defun tramp-rfn-eshadow-update-overlay ()
"Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input.
@ -218,11 +218,11 @@ NAME must be equal to `tramp-current-connection'."
:mode 'tramp-info-lookup-mode :topic 'symbol
:regexp (rx (+ (not (any "\t\n \"'(),[]`‘’"))))
:doc-spec '(("(tramp)Function Index" nil
(rx bol " " (+ "-") " " (* nonl) ": ")
(rx (group (| " " eol))))
(rx bol space (+ "-") space (* nonl) ": ")
(rx (| space eol)))
("(tramp)Variable Index" nil
(rx bol " " (+ "-") " " (* nonl) ": ")
(rx (group (| " " eol))))))
(rx bol space (+ "-") space (* nonl) ": ")
(rx (| space eol)))))
(add-hook
'tramp-integration-unload-hook

27
lisp/net/tramp-sh.el
View File

@ -414,15 +414,13 @@ The string is used in `tramp-methods'.")
,(rx bos (literal tramp-root-id-string) eos) "su"))
(add-to-list 'tramp-default-user-alist
`(,(rx bos (regexp (regexp-opt '("su" "sudo" "doas" "ksu"))) eos)
`(,(rx bos (| "su" "sudo" "doas" "ksu") eos)
nil ,tramp-root-id-string))
;; Do not add "ssh" based methods, otherwise ~/.ssh/config would be ignored.
;; Do not add "plink" based methods, they ask interactively for the user.
(add-to-list 'tramp-default-user-alist
`(,(rx bos
(regexp
(regexp-opt
'("rcp" "remcp" "rsh" "telnet" "nc" "krlogin" "fcp")))
(| "rcp" "remcp" "rsh" "telnet" "nc" "krlogin" "fcp")
eos)
nil ,(user-login-name))))
@ -1250,7 +1248,7 @@ component is used as the target of the symlink."
(tramp-do-file-attributes-with-perl v localname))
(t (tramp-do-file-attributes-with-ls v localname)))))))
(defconst tramp-sunos-unames (regexp-opt '("SunOS 5.10" "SunOS 5.11"))
(defconst tramp-sunos-unames (rx (| "SunOS 5.10" "SunOS 5.11"))
"Regexp to determine remote SunOS.")
(defun tramp-sh--quoting-style-options (vec)
@ -4237,10 +4235,9 @@ file exists and nonzero exit status otherwise."
;; first.
(tramp-send-command
vec (format
(eval-when-compile
(concat
"exec env TERM='%s' INSIDE_EMACS='%s' "
"ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s -i"))
(concat
"exec env TERM='%s' INSIDE_EMACS='%s' "
"ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s -i")
tramp-terminal-type (tramp-inside-emacs)
(or (getenv-internal "ENV" tramp-remote-process-environment) "")
(if (stringp tramp-histfile-override)
@ -4316,10 +4313,9 @@ file exists and nonzero exit status otherwise."
default-shell
(tramp-message
vec 2
(eval-when-compile
(concat
"Couldn't find a remote shell which groks tilde "
"expansion, using `%s'"))
(concat
"Couldn't find a remote shell which groks tilde "
"expansion, using `%s'")
default-shell)))
default-shell)))
@ -4980,7 +4976,8 @@ Goes through the list `tramp-inline-compress-commands'."
string
(and
(string-match
(rx bol (+ (not (any " #"))) " " (+ (not space)) " "
(rx bol (+ (not (any space "#"))) space
(+ (not space)) space
(group (+ (not space))) eol)
string)
(match-string 1 string))
@ -5554,7 +5551,7 @@ Nonexistent directories are removed from spec."
(while candidates
(goto-char (point-min))
(if (string-match-p
(rx bol (literal (car candidates))"%s" (? "\r") eol)
(rx bol (literal (car candidates)) (? "\r") eol)
(buffer-string))
(setq locale (car candidates)
candidates nil)

116
lisp/net/tramp-smb.el
View File

@ -98,15 +98,14 @@ this variable \"client min protocol=NT1\"."
"Regexp of SMB server identification.")
(defconst tramp-smb-prompt
(rx bol (| (: (| "smb:" "PS") " " (+ nonl) "> ")
(rx bol (| (: (| "smb:" "PS") space (+ nonl) "> ")
(: (+ space) "Server"
(+ space) "Comment" eol)))
"Regexp used as prompt in smbclient or powershell.")
(defconst tramp-smb-wrong-passwd-regexp
(regexp-opt
'("NT_STATUS_LOGON_FAILURE"
"NT_STATUS_WRONG_PASSWORD"))
(rx (| "NT_STATUS_LOGON_FAILURE"
"NT_STATUS_WRONG_PASSWORD"))
"Regexp for login error strings of SMB servers.")
(defconst tramp-smb-errors
@ -116,57 +115,56 @@ this variable \"client min protocol=NT1\"."
"Call timed out: server did not respond"
(: (+ (not space)) ": command not found")
"Server doesn't support UNIX CIFS calls"
(regexp (regexp-opt
'(;; Samba.
"ERRDOS"
"ERRHRD"
"ERRSRV"
"ERRbadfile"
"ERRbadpw"
"ERRfilexists"
"ERRnoaccess"
"ERRnomem"
"ERRnosuchshare"
;; See /usr/include/samba-4.0/core/ntstatus.h.
;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000),
;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003),
;; Windows 6.0 (Windows Vista), Windows 6.1 (Windows 7),
;; Windows 6.3 (Windows Server 2012, Windows 10).
"NT_STATUS_ACCESS_DENIED"
"NT_STATUS_ACCOUNT_LOCKED_OUT"
"NT_STATUS_BAD_NETWORK_NAME"
"NT_STATUS_CANNOT_DELETE"
"NT_STATUS_CONNECTION_DISCONNECTED"
"NT_STATUS_CONNECTION_REFUSED"
"NT_STATUS_CONNECTION_RESET"
"NT_STATUS_DIRECTORY_NOT_EMPTY"
"NT_STATUS_DUPLICATE_NAME"
"NT_STATUS_FILE_IS_A_DIRECTORY"
"NT_STATUS_HOST_UNREACHABLE"
"NT_STATUS_IMAGE_ALREADY_LOADED"
"NT_STATUS_INVALID_LEVEL"
"NT_STATUS_INVALID_PARAMETER"
"NT_STATUS_INVALID_PARAMETER_MIX"
"NT_STATUS_IO_TIMEOUT"
"NT_STATUS_LOGON_FAILURE"
"NT_STATUS_NETWORK_ACCESS_DENIED"
"NT_STATUS_NOT_IMPLEMENTED"
"NT_STATUS_NO_LOGON_SERVERS"
"NT_STATUS_NO_SUCH_FILE"
"NT_STATUS_NO_SUCH_USER"
"NT_STATUS_NOT_A_DIRECTORY"
"NT_STATUS_NOT_SUPPORTED"
"NT_STATUS_OBJECT_NAME_COLLISION"
"NT_STATUS_OBJECT_NAME_INVALID"
"NT_STATUS_OBJECT_NAME_NOT_FOUND"
"NT_STATUS_OBJECT_PATH_SYNTAX_BAD"
"NT_STATUS_PASSWORD_MUST_CHANGE"
"NT_STATUS_RESOURCE_NAME_NOT_FOUND"
"NT_STATUS_REVISION_MISMATCH"
"NT_STATUS_SHARING_VIOLATION"
"NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE"
"NT_STATUS_UNSUCCESSFUL"
"NT_STATUS_WRONG_PASSWORD")))))
(| ;; Samba.
"ERRDOS"
"ERRHRD"
"ERRSRV"
"ERRbadfile"
"ERRbadpw"
"ERRfilexists"
"ERRnoaccess"
"ERRnomem"
"ERRnosuchshare"
;; See /usr/include/samba-4.0/core/ntstatus.h.
;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000),
;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003),
;; Windows 6.0 (Windows Vista), Windows 6.1 (Windows 7),
;; Windows 6.3 (Windows Server 2012, Windows 10).
"NT_STATUS_ACCESS_DENIED"
"NT_STATUS_ACCOUNT_LOCKED_OUT"
"NT_STATUS_BAD_NETWORK_NAME"
"NT_STATUS_CANNOT_DELETE"
"NT_STATUS_CONNECTION_DISCONNECTED"
"NT_STATUS_CONNECTION_REFUSED"
"NT_STATUS_CONNECTION_RESET"
"NT_STATUS_DIRECTORY_NOT_EMPTY"
"NT_STATUS_DUPLICATE_NAME"
"NT_STATUS_FILE_IS_A_DIRECTORY"
"NT_STATUS_HOST_UNREACHABLE"
"NT_STATUS_IMAGE_ALREADY_LOADED"
"NT_STATUS_INVALID_LEVEL"
"NT_STATUS_INVALID_PARAMETER"
"NT_STATUS_INVALID_PARAMETER_MIX"
"NT_STATUS_IO_TIMEOUT"
"NT_STATUS_LOGON_FAILURE"
"NT_STATUS_NETWORK_ACCESS_DENIED"
"NT_STATUS_NOT_IMPLEMENTED"
"NT_STATUS_NO_LOGON_SERVERS"
"NT_STATUS_NO_SUCH_FILE"
"NT_STATUS_NO_SUCH_USER"
"NT_STATUS_NOT_A_DIRECTORY"
"NT_STATUS_NOT_SUPPORTED"
"NT_STATUS_OBJECT_NAME_COLLISION"
"NT_STATUS_OBJECT_NAME_INVALID"
"NT_STATUS_OBJECT_NAME_NOT_FOUND"
"NT_STATUS_OBJECT_PATH_SYNTAX_BAD"
"NT_STATUS_PASSWORD_MUST_CHANGE"
"NT_STATUS_RESOURCE_NAME_NOT_FOUND"
"NT_STATUS_REVISION_MISMATCH"
"NT_STATUS_SHARING_VIOLATION"
"NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE"
"NT_STATUS_UNSUCCESSFUL"
"NT_STATUS_WRONG_PASSWORD")))
"Regexp for possible error strings of SMB servers.
Used instead of analyzing error codes of commands.")
@ -1658,11 +1656,11 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"."
"")))
;; Sometimes we have discarded `substitute-in-file-name'.
(when (string-match (rx (group "$$") (group (| "/" eol))) localname)
(when (string-match (rx (group "$$") (| "/" eol)) localname)
(setq localname (replace-match "$" nil nil localname 1)))
;; A trailing space is not supported.
(when (string-match-p (rx " " eol) localname)
(when (string-match-p (rx space eol) localname)
(tramp-error
vec 'file-error
"Invalid file name %s" (tramp-make-tramp-file-name vec localname)))
@ -1821,7 +1819,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)."
(cl-return))
;; weekday.
(if (string-match-p (rx (group (+ wordchar)) eol) line)
(if (string-match-p (rx (+ wordchar) eol) line)
(setq line (substring line 0 -5))
(cl-return))
@ -1856,7 +1854,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)."
;; localname.
(if (string-match
(rx bol (+ space)
(group (not space) (? (group (* nonl) (not space))))
(group (not space) (? (* nonl) (not space)))
(* space) eol)
line)
(setq localname (match-string 1 line))

181
lisp/net/tramp.el
View File

@ -516,8 +516,8 @@ 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 (group (| (literal (downcase tramp-system-name))
(literal (upcase tramp-system-name))))
(list (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
@ -530,9 +530,8 @@ host runs a restricted shell, it shall be added to this list, too."
;;;###tramp-autoload
(defcustom tramp-local-host-regexp
(rx bos
(regexp (regexp-opt
`("localhost" "localhost4" "localhost6"
,tramp-system-name "127.0.0.1" "::1")))
(| (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."
@ -582,7 +581,7 @@ usually suffice.")
(defconst tramp-echoed-echo-mark-regexp
(rx-to-string
`(: ,tramp-echo-mark-marker
(= ,tramp-echo-mark-marker-length (group "\b" (? " \b")))))
(= ,tramp-echo-mark-marker-length "\b" (? " \b"))))
"Regexp which matches `tramp-echo-mark' as it gets echoed by \
the remote shell.")
@ -599,7 +598,7 @@ if you need to change this."
:type 'string)
(defcustom tramp-login-prompt-regexp
(rx (* nonl) (group (| "user" "login")) (? (group " " (* nonl))) ":" (* " "))
(rx (* nonl) (| "user" "login") (? space (* nonl)) ":" (* space))
"Regexp matching login-like prompts.
The regexp should match at end of buffer.
@ -692,9 +691,8 @@ files conditionalize this setup based on the TERM environment variable."
:type 'string)
(defcustom tramp-terminal-prompt-regexp
(rx (group
(| (: "TERM = (" (* nonl) ")")
(: "Terminal type? [" (* nonl) "]")))
(rx (| (: "TERM = (" (* nonl) ")")
(: "Terminal type? [" (* nonl) "]"))
(* space))
"Regular expression matching all terminal setting prompts.
The regexp should match at end of buffer.
@ -706,7 +704,7 @@ The answer will be provided by `tramp-action-terminal', which see."
;; "-no-antispoof". However, since we don't know which PuTTY
;; version is installed, we must react interactively.
(defcustom tramp-antispoof-regexp
(rx (literal "Access granted. Press Return to begin session. "))
(rx "Access granted. Press Return to begin session. ")
"Regular expression matching plink's anti-spoofing message.
The regexp should match at end of buffer."
:version "27.1"
@ -1177,7 +1175,7 @@ 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 "/" (? (group "[" (* (not (any "]"))))) eos)
(rx bos "/" (? "[" (* (not (any "]")))) eos)
(rx bos
;; `file-name-completion' uses absolute paths for matching.
;; This means that on W32 systems, something like
@ -1942,11 +1940,11 @@ of `current-buffer'."
(defconst tramp-debug-outline-regexp
(rx ;; Timestamp.
(+ digit) ":" (+ digit) ":" (+ digit) "." (+ digit) " "
(+ digit) ":" (+ digit) ":" (+ digit) "." (+ digit) space
;; Thread.
(? (group "#<thread " (+ nonl) ">") " ")
(? (group "#<thread " (+ nonl) ">") space)
;; Function name, verbosity.
(+ (any "-" alnum)) " (" (group (group (+ digit))) ") #")
(+ (any "-" alnum)) " (" (group (+ digit)) ") #")
"Used for highlighting Tramp debug buffers in `outline-mode'.")
(defconst tramp-debug-font-lock-keywords
@ -2804,7 +2802,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 (rx bol (regexp (regexp-opt files)) eol)))
(mapatoms
(lambda (atom)
(when (and (functionp atom)
@ -3038,58 +3036,58 @@ not in completion mode."
(defun tramp-completion-dissect-file-name (name)
"Return a list of `tramp-file-name' structures for NAME.
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)
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)
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)
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)
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)
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)
1 2 3 nil)))
(let (;; "/method" "/[method"
(tramp-completion-file-name-structure1
(list
(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)
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)
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)
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)
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)
1 2 3 nil)))
(delq
nil
(mapcar
@ -3356,14 +3354,14 @@ User is always nil."
registry-or-dirname (rx bol (group (regexp tramp-host-regexp)) eol))))
(defun tramp-parse-putty-group (registry)
"Return a (user host) tuple allowed to access.
"Return a (user host) tuple allowed to access.
User is always nil."
(let (result
(regexp (rx (literal registry) "\\" (group (+ nonl)))))
(when (re-search-forward regexp (line-end-position) t)
(setq result (list nil (match-string 1))))
(forward-line 1)
result))
(let (result
(regexp (rx (literal registry) "\\" (group (+ nonl)))))
(when (re-search-forward regexp (line-end-position) t)
(setq result (list nil (match-string 1))))
(forward-line 1)
result))
;;; Skeleton macros for file name handler functions.
@ -4104,10 +4102,9 @@ Let-bind it when necessary.")
(not (with-tramp-connection-property
(tramp-get-process v) "unsafe-temporary-file"
(yes-or-no-p
(eval-when-compile
(concat
"Backup file on local temporary directory, "
"do you want to continue?"))))))
(concat
"Backup file on local temporary directory, "
"do you want to continue?")))))
(tramp-error v 'file-error "Unsafe backup file name"))))))
(defun tramp-handle-insert-directory
@ -4439,7 +4436,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.")
(rx bos (group (+ nonl))
"@" (group (+ nonl))
"." (group (+ digit))
(? ":" (group (+ digit))) eos)
(? ":" (+ digit)) eos)
"The format of a lock file.")
(defun tramp-handle-file-locked-p (file)
@ -4494,10 +4491,9 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.")
(not (with-tramp-connection-property
(tramp-get-process v) "unsafe-temporary-file"
(yes-or-no-p
(eval-when-compile
(concat
"Lock file on local temporary directory, "
"do you want to continue?"))))))
(concat
"Lock file on local temporary directory, "
"do you want to continue?")))))
(tramp-error v 'file-error "Unsafe lock file name")))
;; Do the lock.
@ -6112,10 +6108,9 @@ this file, if that variable is non-nil."
(not (with-tramp-connection-property
(tramp-get-process v) "unsafe-temporary-file"
(yes-or-no-p
(eval-when-compile
(concat
"Autosave file on local temporary directory, "
"do you want to continue?"))))))
(concat
"Autosave file on local temporary directory, "
"do you want to continue?")))))
(tramp-error v 'file-error "Unsafe autosave file name"))))))
(defun tramp-subst-strs-in-string (alist string)
@ -6389,15 +6384,13 @@ would use a wrong quoting for local file names. See `w32-shell-name'."
Only works for Bourne-like shells."
(let ((system-type 'not-windows))
(save-match-data
(let ((result (tramp-unquote-shell-quote-argument s))
(nl (regexp-quote (format "\\%s" tramp-rsh-end-of-line))))
(let ((result (tramp-unquote-shell-quote-argument s)))
(when (and (>= (length result) 2)
(string= (substring result 0 2) "\\~"))
(setq result (substring result 1)))
(while (string-match nl result)
(setq result (replace-match (format "'%s'" tramp-rsh-end-of-line)
t t result)))
result))))
(replace-regexp-in-string
(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
;;; the process property `remote-pid'.

8
test/lisp/net/tramp-archive-tests.el
View File

@ -622,7 +622,7 @@ This checks also `file-name-as-directory', `file-name-directory',
(goto-char (point-min))
(should
(looking-at-p
(rx bol (+ nonl) " " (literal tramp-archive-test-archive) eol))))
(rx bol (+ nonl) space (literal tramp-archive-test-archive) eol))))
(with-temp-buffer
(insert-directory
(file-name-as-directory tramp-archive-test-archive)
@ -633,14 +633,14 @@ This checks also `file-name-as-directory', `file-name-directory',
(rx-to-string
`(:
;; There might be a summary line.
(? "total" (+ nonl) (+ digit) (? " ")
(? "total" (+ nonl) (+ digit) (? space)
(? (any "EGKMPTYZk")) (? "i") (? "B") "\n")
;; We don't know in which order the files appear.
(= ,(length (directory-files tramp-archive-test-archive))
(+ nonl) " "
(+ nonl) space
(regexp
,(regexp-opt (directory-files tramp-archive-test-archive)))
(? " ->" (one-or-more nonl)) "\n"))))))
(? " ->" (+ nonl)) "\n"))))))
;; Check error case.
(with-temp-buffer
(should-error

10
test/lisp/net/tramp-tests.el
View File

@ -3222,13 +3222,13 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(insert-directory tmp-name1 "-al")
(goto-char (point-min))
(should
(looking-at-p (rx bol (+ nonl) " " (literal tmp-name1) eol))))
(looking-at-p (rx bol (+ nonl) space (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) " " (literal tmp-name1) "/" eol))))
(rx bol (+ nonl) space (literal tmp-name1) "/" eol))))
(with-temp-buffer
(insert-directory
(file-name-as-directory tmp-name1) "-al" nil 'full-directory-p)
@ -3238,11 +3238,11 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(rx-to-string
`(:
;; There might be a summary line.
(? "total" (+ nonl) (+ digit) (? " ")
(? "total" (+ nonl) (+ digit) (? space)
(? (any "EGKMPTYZk")) (? "i") (? "B") "\n")
;; We don't know in which order ".", ".." and "foo" appear.
(= ,(length (directory-files tmp-name1))
(+ nonl) " "
(+ nonl) space
(regexp ,(regexp-opt (directory-files tmp-name1)))
(? " ->" (+ nonl)) "\n"))))))
@ -6703,7 +6703,7 @@ Additionally, ls does not support \"--dired\"."
"Check, whether the method needs a share."
(and (tramp--test-gvfs-p)
(string-match-p
(rx bol (or "afp" (: "dav" (opt "s")) "smb") eol)
(rx bol (| "afp" (: "dav" (? "s")) "smb") eol)
(file-remote-p ert-remote-temporary-file-directory 'method))))
(defun tramp--test-sshfs-p ()