diff options
Diffstat (limited to 'lisp/net/tramp-gvfs.el')
| -rw-r--r-- | lisp/net/tramp-gvfs.el | 128 |
1 files changed, 69 insertions, 59 deletions
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index ca5e959bea5..9060f37ed57 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -410,9 +410,9 @@ It has been changed in GVFS 1.14.") ;; </interface> (defconst tramp-goa-identity-regexp - (concat "^" "\\(" tramp-user-regexp "\\)?" - "@" "\\(" tramp-host-regexp "\\)?" - "\\(?:" ":""\\(" tramp-port-regexp "\\)" "\\)?") + (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" @@ -712,13 +712,13 @@ It has been changed in GVFS 1.14.") (eval-and-compile (defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp - (concat "[[:blank:]]" (regexp-opt tramp-gvfs-file-attributes t) "=\\(.+?\\)") + (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 - (concat "^[[:blank:]]*" - (regexp-opt tramp-gvfs-file-attributes t) - ":[[:blank:]]+\\(.*\\)$") + (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 @@ -728,16 +728,16 @@ It has been changed in GVFS 1.14.") "GVFS file system attributes.") (defconst tramp-gvfs-file-system-attributes-regexp - (concat "^[[:blank:]]*" - (regexp-opt tramp-gvfs-file-system-attributes t) - ":[[:blank:]]+\\(.*\\)$") + (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 - (concat (regexp-quote tramp-gvfs-nextcloud-default-prefix) "$") + (rx (literal tramp-gvfs-nextcloud-default-prefix) eol) "Regexp of default prefix for owncloud / nextcloud methods.") @@ -868,7 +868,7 @@ arguments to pass to the OPERATION." (defun tramp-gvfs-dbus-string-to-byte-array (string) "Like `dbus-string-to-byte-array' but add trailing \\0 if needed." (dbus-string-to-byte-array - (if (string-match-p "^(aya{sv})" tramp-gvfs-mountlocation-signature) + (if (string-match-p (rx bol "(aya{sv})") tramp-gvfs-mountlocation-signature) (concat string (string 0)) string))) (defun tramp-gvfs-dbus-byte-array-to-string (byte-array) @@ -902,7 +902,7 @@ The call will be traced by Tramp with trace level 6." (let (result) (tramp-message vec 6 "%s" (cons func args)) (setq result (apply func args)) - (tramp-message vec 6 "%s" result(tramp-gvfs-stringify-dbus-message result)) + (tramp-message vec 6 "%s" (tramp-gvfs-stringify-dbus-message result)) result)) (put #'tramp-dbus-function 'tramp-suppress-trace t) @@ -1157,7 +1157,9 @@ file names." ;; Dissect NAME. (with-parsed-tramp-file-name name nil ;; If there is a default location, expand tilde. - (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname) + (when (string-match + (rx bos "~" (group (* (not (any "/")))) (group (* nonl)) eos) + localname) (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) hname) @@ -1167,26 +1169,28 @@ file names." (setq localname (concat hname fname))))) ;; Tilde expansion is not possible. (when (and (not tramp-tolerate-tilde) - (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)) + (string-prefix-p "~" localname)) (tramp-error v 'file-error "Cannot expand tilde in file `%s'" name)) (unless (tramp-run-real-handler #'file-name-absolute-p (list localname)) (setq localname (concat "/" localname))) ;; We do not pass "/..". - (if (string-match-p "^\\(afp\\|davs?\\|smb\\)$" method) - (when (string-match "^/[^/]+\\(/\\.\\./?\\)" localname) + (if (string-match-p (rx bos (| "afp" (: "dav" (? "s")) "smb") eos) method) + (when (string-match + (rx bos "/" (+ (not (any "/"))) (group "/.." (? "/"))) + localname) (setq localname (replace-match "/" t t localname 1))) - (when (string-match "^/\\.\\./?" localname) + (when (string-match (rx bol "/.." (? "/")) localname) (setq localname (replace-match "/" t t localname)))) ;; There might be a double slash. Remove this. (while (string-match "//" localname) (setq localname (replace-match "/" t t localname))) ;; Do not keep "/..". - (when (string-match-p "^/\\.\\.?$" localname) + (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname) (setq localname "/")) ;; Do normal `expand-file-name' (this does "/./" and "/../"), ;; unless there are tilde characters in file name. (tramp-make-tramp-file-name - v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + v (if (string-prefix-p "~" localname) localname (tramp-run-real-handler #'expand-file-name (list localname))))))) @@ -1208,20 +1212,20 @@ file names." (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) (while (looking-at - (eval-when-compile - (concat "^\\(.+\\)[[:blank:]]" - "\\([[:digit:]]+\\)[[:blank:]]" - "(\\(.+?\\))" - tramp-gvfs-file-attributes-with-gvfs-ls-regexp))) + (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 - (concat - tramp-gvfs-file-attributes-with-gvfs-ls-regexp - "\\(" tramp-gvfs-file-attributes-with-gvfs-ls-regexp - "\\|" "$" "\\)")) + (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. @@ -1266,8 +1270,10 @@ If FILE-SYSTEM is non-nil, return file system attributes." (setq filename (directory-file-name (expand-file-name filename))) (with-parsed-tramp-file-name filename nil (setq localname (tramp-compat-file-name-unquote localname)) - (if (or (and (string-match-p "^\\(afp\\|davs?\\|smb\\)$" method) - (string-match-p "^/?\\([^/]+\\)$" localname)) + (if (or (and (string-match-p + (rx bol (| "afp" (: "dav" (? "s")) "smb") eol) method) + (string-match-p + (rx bol (? "/") (+ (not (any "/"))) eol) localname)) (string-equal localname "/")) (tramp-gvfs-get-root-attributes filename) (assoc @@ -1297,7 +1303,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." ;; Convert them to multibyte. (decode-coding-string (replace-regexp-in-string - "\\\\x\\([[:xdigit:]]\\{2\\}\\)" + (rx "\\x" (group (= 2 xdigit))) (lambda (x) (unibyte-string (string-to-number (match-string 1 x) 16))) res-symlink-target) @@ -1467,7 +1473,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 (regexp-quote (tramp-gvfs-url-file-name dd)))) + (ddu (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) @@ -1481,15 +1487,15 @@ If FILE-SYSTEM is non-nil, return file system attributes." "renamed to" "moved" string)) ;; https://bugs.launchpad.net/bugs/1742946 (when - (string-match-p "Monitoring not supported\\|No locations given" string) + (string-match-p + (rx (| "Monitoring not supported" "No locations given")) string) (delete-process proc)) (while (string-match - (eval-when-compile - (concat "^.+:" - "[[:space:]]\\(.+\\):" - "[[:space:]]" (regexp-opt tramp-gio-events t) - "\\([[:space:]]\\(.+\\)\\)?$")) + (rx bol (+ nonl) ":" + space (group (+ nonl)) ":" + space (group (regexp (regexp-opt tramp-gio-events))) + (? (group space (group (+ nonl)))) eol) string) (let ((file (match-string 1 string)) @@ -1499,11 +1505,11 @@ If FILE-SYSTEM is non-nil, return file system attributes." ;; File names are returned as URL paths. We must convert them. (when (string-match ddu file) (setq file (replace-match dd nil nil file))) - (while (string-match-p "%\\([[:xdigit:]]\\{2\\}\\)" file) + (while (string-match-p (rx "%" (= 2 xdigit)) file) (setq file (url-unhex-string file))) (when (string-match ddu (or file1 "")) (setq file1 (replace-match dd nil nil file1))) - (while (string-match-p "%\\([[:xdigit:]]\\{2\\}\\)" (or file1 "")) + (while (string-match-p (rx "%" (= 2 xdigit)) (or file1 "")) (setq file1 (url-unhex-string file1))) ;; Remove watch when file or directory to be watched is deleted. (when (and (member action '(moved deleted)) @@ -1719,14 +1725,15 @@ ID-FORMAT valid values are `string' and `integer'." (defun tramp-gvfs-file-name (object-path) "Retrieve file name from D-Bus OBJECT-PATH." (dbus-unescape-from-identifier - (replace-regexp-in-string "^.*/\\([^/]+\\)$" "\\1" object-path))) + (replace-regexp-in-string + (rx bol (* nonl) "/" (+ (not (any "/"))) eol) "\\1" object-path))) (defun tramp-gvfs-url-host (url) "Return the host name part of URL, a string. We cannot use `url-host', because `url-generic-parse-url' returns a downcased host name only." (and (stringp url) - (string-match "^[[:alnum:]]+://\\([^/:]+\\)" url) + (string-match (rx bol (+ alnum) "://" (group (+ (not (any "/:"))))) url) (match-string 1 url))) @@ -1739,7 +1746,8 @@ a downcased host name only." (pw-prompt (format "%s for %s " - (if (string-match "\\([pP]assword\\|[pP]assphrase\\)" message) + (if (string-match + (rx (group (any "Pp") (| "assword" "assphrase"))) message) (capitalize (match-string 1 message)) "Password") filename)) @@ -1861,7 +1869,7 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\" and (cadr (assoc "ssl" (cadr mount-spec))))) (uri (tramp-gvfs-dbus-byte-array-to-string (cadr (assoc "uri" (cadr mount-spec)))))) - (when (string-match "^\\(afp\\|smb\\)" method) + (when (string-match (rx bol (group (| "afp" "smb"))) method) (setq method (match-string 1 method))) (when (and (string-equal "dav" method) (string-equal "true" ssl)) (setq method "davs")) @@ -1961,7 +1969,7 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\" and (or (cadr (assoc "share" (cadr mount-spec))) (cadr (assoc "volume" (cadr mount-spec))))))) - (when (string-match "^\\(afp\\|smb\\)" method) + (when (string-match (rx bol (group (| "afp" "smb"))) method) (setq method (match-string 1 method))) (when (and (string-equal "dav" method) (string-equal "true" ssl)) (setq method "davs")) @@ -1993,7 +2001,7 @@ 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 (concat "^/" (regexp-quote (or share ""))) + (string-match-p (rx bol "/" (literal (or share ""))) (tramp-file-name-unquote-localname vec))) ;; Set mountpoint and location. (tramp-set-file-property vec "/" "fuse-mountpoint" fuse-mountpoint) @@ -2019,7 +2027,7 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\" and (defun tramp-gvfs-mount-spec-entry (key value) "Construct a mount-spec entry to be used in a mount_spec. It was \"a(say)\", but has changed to \"a{sv})\"." - (if (string-match-p "^(aya{sv})" tramp-gvfs-mountlocation-signature) + (if (string-match-p (rx bol "(aya{sv})") tramp-gvfs-mountlocation-signature) (list :dict-entry key (list :variant (tramp-gvfs-dbus-string-to-byte-array value))) (list :struct key (tramp-gvfs-dbus-string-to-byte-array value)))) @@ -2037,9 +2045,11 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (port (if media (tramp-media-device-port media) (tramp-file-name-port vec))) (localname (tramp-file-name-unquote-localname vec)) - (share (when (string-match "^/?\\([^/]+\\)" localname) + (share (when (string-match + (rx bol (? "/") (group (+ (not (any "/"))))) localname) (match-string 1 localname))) - (ssl (if (string-match-p "^davs\\|^nextcloud" method) "true" "false")) + (ssl (if (string-match-p (rx bol (| "davs" "nextcloud")) method) + "true" "false")) (mount-spec `(:array ,@(cond @@ -2047,7 +2057,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (list (tramp-gvfs-mount-spec-entry "type" "smb-share") (tramp-gvfs-mount-spec-entry "server" host) (tramp-gvfs-mount-spec-entry "share" share))) - ((string-match-p "^dav\\|^nextcloud" method) + ((string-match-p (rx bol (| "davs" "nextcloud")) method) (list (tramp-gvfs-mount-spec-entry "type" "dav") (tramp-gvfs-mount-spec-entry "host" host) (tramp-gvfs-mount-spec-entry "ssl" ssl))) @@ -2061,7 +2071,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"." ((string-equal "nextcloud" method) (list (tramp-gvfs-mount-spec-entry "type" "owncloud") (tramp-gvfs-mount-spec-entry "host" host))) - ((string-match-p "^http" method) + ((string-match-p (rx bol "http") method) (list (tramp-gvfs-mount-spec-entry "type" "http") (tramp-gvfs-mount-spec-entry "uri" @@ -2078,8 +2088,8 @@ It was \"a(say)\", but has changed to \"a{sv})\"." ,@(when port (list (tramp-gvfs-mount-spec-entry "port" port))))) (mount-pref - (if (and (string-match-p "^dav" method) - (string-match "^/?[^/]+" localname)) + (if (and (string-match-p (rx bol "dav") method) + (string-match (rx bol (? "/") (+ (not (any "/")))) localname)) (match-string 0 localname) (tramp-gvfs-get-remote-prefix vec)))) @@ -2166,7 +2176,7 @@ connection if a previous connection has died for some reason." (string-equal localname "/")) (tramp-user-error vec "Filename must contain an AFP volume")) - (when (and (string-match-p "davs?" method) + (when (and (string-match-p (rx "dav" (? "s")) method) (string-equal localname "/")) (tramp-user-error vec "Filename must contain a WebDAV share")) @@ -2216,7 +2226,7 @@ connection if a previous connection has died for some reason." ;; The call must be asynchronously, because of the "askPassword" ;; or "askQuestion" callbacks. - (if (string-match-p "(so)$" tramp-gvfs-mountlocation-signature) + (if (string-match-p (rx "(so)" eol) tramp-gvfs-mountlocation-signature) (with-tramp-dbus-call-method vec nil :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation @@ -2446,7 +2456,7 @@ It checks for mounted media devices." (text (zeroconf-service-txt x)) user) (when port - (setq host (format "%s%s%d" host tramp-prefix-port-regexp port))) + (setq host (format "%s%s%d" host tramp-prefix-port-format port))) ;; A user is marked in a TXT field like "u=guest". (while text (when (string-match "u=\\(.+\\)$" (car text)) @@ -2462,7 +2472,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi." (ignore-errors (split-string (shell-command-to-string (format "avahi-browse -trkp %s" service)) - "[\n\r]+" 'omit "^\\+;.*$")))) + (rx (+ (any "\r\n"))) 'omit (rx bol "+;" (* nonl) eol))))) (delete-dups (mapcar (lambda (x) @@ -2472,7 +2482,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi." user) ;; A user is marked in a TXT field like "u=guest". (while text - (when (string-match "u=\\(.+\\)$" (car text)) + (when (string-match (rx "u=" (group (+ nonl)) eol) (car text)) (setq user (match-string 1 (car text)))) (setq text (cdr text))) (list user host))) |