emacs-31 bd5cbf47da6: Backport: Restrict Tramp user name
Michael Albinus via Mailing list for Emacs changes <[email protected]>
| Newsgroups | gmane.emacs.diffs |
|---|---|
| Message-ID | <[email protected]> |
branch: emacs-31 commit bd5cbf47da6403a571a2e839522f43e44a06bed3 Author: Michael Albinus <[email protected]> Commit: Michael Albinus <[email protected]> Backport: Restrict Tramp user name * doc/misc/tramp.texi (File name syntax): The user name can also be an environment variable. * lisp/net/tramp.el (tramp-build-prefix-regexp): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-expand-file-name) (tramp-gvfs-get-file-attributes, tramp-gvfs-file-name) (tramp-gvfs-url-host, tramp-gvfs-handler-mounted-unmounted) (tramp-gvfs-connection-mounted-p, tramp-gvfs-mount-spec-entry) (tramp-gvfs-mount-spec): * lisp/net/tramp-rclone.el (tramp-rclone-parse-device-names) (tramp-rclone-remote-file-name): * lisp/net/tramp-smb.el (tramp-smb-get-share, tramp-smb-get-localname): Use string-anchored regexp, not line-anchored. * lisp/net/tramp.el (tramp-prefix-regexp): Adapt docstring. (tramp-user-regexp): Exclude shell meta characters. (tramp-dissect-file-name, tramp-file-name-handler): Expand environment variable. (tramp-convert-file-attributes): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-attributes): Quote symbolic link target with remote file name syntax. * test/lisp/net/tramp-tests.el (tramp-test01-file-name-syntax) (tramp-test01-file-name-syntax-simplified) (tramp-test01-file-name-syntax-separate) (tramp-test02-file-name-dissect) (tramp-test02-file-name-dissect-simplified) (tramp-test02-file-name-dissect-separate) (tramp-test21-file-links): Extend test. (cherry picked from commit f3e7104d05bdb8e32ba13bf75604108ad88536dc) --- doc/misc/tramp.texi | 4 +- lisp/net/tramp-gvfs.el | 36 ++++++++++-------- lisp/net/tramp-rclone.el | 4 +- lisp/net/tramp-smb.el | 6 +-- lisp/net/tramp.el | 16 ++++++-- test/lisp/net/tramp-tests.el | 89 ++++++++++++++++++++++++++++++++++++++++---- 6 files changed, 121 insertions(+), 34 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 7bee92a94d5..9f1a1d02867 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -3689,7 +3689,9 @@ brackets @file{@value{ipv6prefix}} and @file{@value{ipv6postfix}}. By default, @value{tramp} will use the current local user name as the remote user name for log in to the remote host. Specifying a different name using the proper syntax will override this default -behavior: @file{@trampfn{method,user@@host,path/to/file}}. +behavior: @file{@trampfn{method,user@@host,path/to/file}}. The user +name can also be taken from an environment variable, like +@file{@trampfn{method,@env{$MY_REMOTE_USER}@@host,path/to/file}}. @file{@trampfn{ssh,daniel@@melancholia,.emacs}} is for file @file{.emacs} in @samp{daniel}'s home directory on the host, diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index a5919e071c3..ecd298e4525 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1246,7 +1246,7 @@ file names." (when (string-match (rx bos "/" (+ (not "/")) (group "/.." (? "/"))) localname) (setq localname (replace-match "/" t t localname 1))) - (when (string-match (rx bol "/.." (? "/")) localname) + (when (string-match (rx bos "/.." (? "/")) localname) (setq localname (replace-match "/" t t localname)))) ;; There might be a double slash. Remove this. (while (string-match "//" localname) @@ -1340,8 +1340,8 @@ If FILE-SYSTEM is non-nil, return file system attributes." (with-parsed-tramp-file-name filename nil (setq localname (file-name-unquote localname)) (if (or (and (string-match-p - (rx bol (| "afp" (: "dav" (? "s")) "smb") eol) method) - (string-match-p (rx bol (? "/") (+ (not "/")) eol) localname)) + (rx bos (| "afp" (: "dav" (? "s")) "smb") eos) method) + (string-match-p (rx bos (? "/") (+ (not "/")) eos) localname)) (string-equal localname "/")) (tramp-gvfs-get-root-attributes filename) (assoc @@ -1375,7 +1375,11 @@ If FILE-SYSTEM is non-nil, return file system attributes." (lambda (x) (unibyte-string (string-to-number (match-string 1 x) 16))) res-symlink-target) - 'utf-8))) + 'utf-8)) + ;; If the resulting localname looks remote, we must quote it + ;; for security reasons. + (when (tramp-tramp-file-p res-symlink-target) + (setq res-symlink-target (file-name-quote res-symlink-target 'top)))) ;; ... number links (setq res-numlinks (string-to-number @@ -1768,14 +1772,14 @@ 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 "/"))) eol) "\\1" object-path))) + (rx bos (* nonl) "/" (group (+ (not "/"))) eos) "\\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 (rx bol (+ alnum) "://" (group (+ (not (any "/:"))))) url) + (string-match (rx bos (+ alnum) "://" (group (+ (not (any "/:"))))) url) (match-string 1 url))) ;; This is used in GNU ELPA package tramp-locproc.el. @@ -1929,7 +1933,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 (rx bol (group (| "afp" "smb"))) method) + (when (string-match (rx bos (group (| "afp" "smb"))) method) (setq method (match-string 1 method))) (when (and (string-equal "dav" method) (string-equal "true" ssl)) (setq method "davs")) @@ -2029,7 +2033,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 (rx bol (group (| "afp" "smb"))) method) + (when (string-match (rx bos (group (| "afp" "smb"))) method) (setq method (match-string 1 method))) (when (and (string-equal "dav" method) (string-equal "true" ssl)) (setq method "davs")) @@ -2062,7 +2066,7 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\" and (string-equal host (tramp-file-name-host vec)) (string-equal port (tramp-file-name-port vec)) (string-match-p - (rx bol "/" (literal (or share ""))) + (rx bos "/" (literal (or share ""))) (tramp-file-name-unquote-localname vec))) ;; Set mountpoint and location. (tramp-set-file-property vec "/" "fuse-mountpoint" fuse-mountpoint) @@ -2088,7 +2092,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 (rx bol "(aya{sv})") tramp-gvfs-mountlocation-signature) + (if (string-match-p (rx bos "(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)))) @@ -2107,9 +2111,9 @@ 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 "/")))) localname) + (rx bos (? "/") (group (+ (not "/")))) localname) (match-string 1 localname))) - (ssl (if (string-match-p (rx bol (| "davs" "nextcloud")) method) + (ssl (if (string-match-p (rx bos (| "davs" "nextcloud")) method) "true" "false")) (mount-spec `(:array @@ -2118,7 +2122,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 (rx bol (| "davs" "nextcloud")) method) + ((string-match-p (rx bos (| "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))) @@ -2132,7 +2136,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 (rx bol "http") method) + ((string-match-p (rx bos "http") method) (list (tramp-gvfs-mount-spec-entry "type" "http") (tramp-gvfs-mount-spec-entry "uri" @@ -2149,8 +2153,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 (rx bol "dav") method) - (string-match (rx bol (? "/") (+ (not "/"))) localname)) + (if (and (string-match-p (rx bos "dav") method) + (string-match (rx bos (? "/") (+ (not "/"))) localname)) (match-string 0 localname) (tramp-gvfs-get-remote-prefix vec)))) diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index cd5c3f46f54..125640560ff 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -192,7 +192,7 @@ arguments to pass to the OPERATION." (with-tramp-connection-property nil "rclone-device-names" (tramp-compat-seq-keep (lambda (line) - (when (string-match (rx bol (group (+ (not blank))) ":" eol) line) + (when (string-match (rx bos (group (+ (not blank))) ":" eos) line) `(nil ,(match-string 1 line)))) (tramp-process-lines nil tramp-rclone-program "listremotes")))) @@ -366,7 +366,7 @@ file names." (tramp-rclone-maybe-open-connection v) ;; TODO: This shall be handled by `expand-file-name'. (setq localname - (replace-regexp-in-string (rx bol ".") "" (or localname ""))) + (replace-regexp-in-string (rx bos ".") "" (or localname ""))) (format "%s%s" (tramp-fuse-mounted-p v) localname))) ;; It is a local file name. filename)) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 6f88c7dedba..2ed5f3369a6 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1657,7 +1657,7 @@ VEC or USER, or if there is no home directory, return nil." "Return the share name of LOCALNAME." (save-match-data (let ((localname (tramp-file-name-unquote-localname vec))) - (when (string-match (rx bol (? "/") (group (+ (not "/"))) "/") localname) + (when (string-match (rx bos (? "/") (group (+ (not "/"))) "/") localname) (match-string 1 localname))))) (defun tramp-smb-get-localname (vec &optional share) @@ -1670,7 +1670,7 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"." (setq localname (if (string-match - (rx bol (? "/") (+ (not "/")) (group "/" (* nonl))) localname) + (rx bos (? "/") (+ (not "/")) (group "/" (* nonl))) localname) ;; There is a share, separated by "/". (if (not (tramp-smb-get-cifs-capabilities vec)) (mapconcat @@ -1679,7 +1679,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 "/"))) eol) localname) + (rx bos (? "/") (group (+ (not "/"))) eos) localname) (match-string 1 localname) "")))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index eb0bc649d69..792887da772 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1024,11 +1024,11 @@ Used in `tramp-make-tramp-file-name'.") (defun tramp-build-prefix-regexp () "Return `tramp-prefix-regexp'." - (rx bol (literal (tramp-build-prefix-format)))) + (rx bos (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'.") +Should always start with \"\\\\=`\". Derived from `tramp-prefix-format'.") (defconst tramp-method-regexp-alist `((default . ,(rx (| (literal tramp-default-method-marker) (>= 2 alnum)))) @@ -1070,7 +1070,10 @@ Used in `tramp-make-tramp-file-name'.") "Regexp matching delimiter between method and user or host names. Derived from `tramp-postfix-method-format'.") -(defconst tramp-user-regexp (rx (+ (not (any "/:|[]" blank)))) +(defconst tramp-user-regexp + (rx (| (+ (not (any "/\\^$?*:;|[]{}()<>`'\"" blank))) + ;; Environment variable. + (: "$" (+ (any "_" alnum))))) "Regexp matching user names.") (defconst tramp-prefix-domain-format "%" @@ -1845,6 +1848,8 @@ default values are used." (hop (match-string (nth 5 tramp-file-name-structure) name)) domain port v) (when user + (while (string-match (rx bos "$" (group (+ (any "_" alnum))) eos) user) + (setq user (getenv (match-string 1 user)))) (when (string-match tramp-user-with-domain-regexp user) (setq domain (match-string 2 user) user (match-string 1 user)))) @@ -2705,9 +2710,9 @@ Fall back to normal file name handler if no Tramp file name handler exists." ;; `file-remote-p' is called for everything, even for symbolic ;; links which look remote. We don't want to get an error. (non-essential (or non-essential (eq operation 'file-remote-p)))) + (setq filename (tramp-replace-environment-variables filename)) (if (tramp-tramp-file-p filename) (save-match-data - (setq filename (tramp-replace-environment-variables filename)) (with-parsed-tramp-file-name filename nil (let ((current-connection tramp-current-connection) (foreign @@ -6950,6 +6955,9 @@ to cache the result. Return the modified ATTR." (caar attr)) (decode-coding-string (match-string 1 (caar attr)) 'utf-8)))) + ;; Quote remote-like symlink. + (when (and (stringp (car attr)) (tramp-tramp-file-p (car attr))) + (setcar attr (file-name-quote (car attr) 'top))) ;; Set file's gid change bit. (setcar (nthcdr 9 attr) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 6badf064efe..d9571174439 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -413,6 +413,7 @@ being the result.") (should (tramp-tramp-file-p "/method:user@:")) (should (tramp-tramp-file-p "/method:user@host:")) (should (tramp-tramp-file-p "/method:user@email@host:")) + (should (tramp-tramp-file-p "/method:$USER@host:")) ;; Using a port. (should (tramp-tramp-file-p "/method:host#1234:")) @@ -509,6 +510,7 @@ being the result.") (should (tramp-tramp-file-p "/user@:")) (should (tramp-tramp-file-p "/user@host:")) (should (tramp-tramp-file-p "/user@email@host:")) + (should (tramp-tramp-file-p "/$USER@host:")) ;; Using a port. (should (tramp-tramp-file-p "/host#1234:")) @@ -571,6 +573,7 @@ being the result.") (should (tramp-tramp-file-p "/[method/user@]")) (should (tramp-tramp-file-p "/[method/user@host]")) (should (tramp-tramp-file-p "/[method/user@email@host]")) + (should (tramp-tramp-file-p "/[method/$USER@host]")) ;; Using a port. (should (tramp-tramp-file-p "/[method/host#1234]")) @@ -759,6 +762,28 @@ being the result.") (should (string-equal (file-remote-p "/method:user@email@host:" 'hop) nil)) + ;; Expand environment variable. It can be cascaded. + (with-environment-variables + (("REMOTE_USER" "$REMOTE_USER1") ("REMOTE_USER1" "remote-user")) + (should (string-equal + (file-remote-p "/method:$REMOTE_USER@host:") + (format "/%s:%s@%s:" "method" "remote-user" "host"))) + (should + (string-equal + (file-remote-p "/method:$REMOTE_USER@host:" 'method) "method")) + (should + (string-equal + (file-remote-p "/method:$REMOTE_USER@host:" 'user) "remote-user")) + (should + (string-equal + (file-remote-p "/method:$REMOTE_USER@host:" 'host) "host")) + (should + (string-equal + (file-remote-p "/method:$REMOTE_USER@host:" 'localname) "")) + (should + (string-equal + (file-remote-p "/method:$REMOTE_USER@host:" 'hop) nil))) + ;; Expand `tramp-default-method' and `tramp-default-user'. (should (string-equal @@ -1239,6 +1264,28 @@ being the result.") (should (string-equal (file-remote-p "/user@email@host:" 'hop) nil)) + ;; Expand environment variable. It can be cascaded. + (with-environment-variables + (("REMOTE_USER" "$REMOTE_USER1") ("REMOTE_USER1" "remote-user")) + (should (string-equal + (file-remote-p "/$REMOTE_USER@host:") + (format "/%s@%s:" "remote-user" "host"))) + (should + (string-equal + (file-remote-p "/$REMOTE_USER@host:" 'method) "default-method")) + (should + (string-equal + (file-remote-p "/$REMOTE_USER@host:" 'user) "remote-user")) + (should + (string-equal + (file-remote-p "/$REMOTE_USER@host:" 'host) "host")) + (should + (string-equal + (file-remote-p "/$REMOTE_USER@host:" 'localname) "")) + (should + (string-equal + (file-remote-p "/$REMOTE_USER@host:" 'hop) nil))) + ;; Expand `tramp-default-method' and `tramp-default-user'. (should (string-equal (file-remote-p "/host#1234:") @@ -1715,6 +1762,28 @@ being the result.") (should (string-equal (file-remote-p "/[method/user@email@host]" 'hop) nil)) + ;; Expand environment variable. It can be cascaded. + (with-environment-variables + (("REMOTE_USER" "$REMOTE_USER1") ("REMOTE_USER1" "remote-user")) + (should (string-equal + (file-remote-p "/[method/$REMOTE_USER@host]") + (format "/[%s/%s@%s]" "method" "remote-user" "host"))) + (should + (string-equal + (file-remote-p "/[method/$REMOTE_USER@host]" 'method) "method")) + (should + (string-equal + (file-remote-p "/[method/$REMOTE_USER@host]" 'user) "remote-user")) + (should + (string-equal + (file-remote-p "/[method/$REMOTE_USER@host]" 'host) "host")) + (should + (string-equal + (file-remote-p "/[method/$REMOTE_USER@host]" 'localname) "")) + (should + (string-equal + (file-remote-p "/[method/$REMOTE_USER@host]" 'hop) nil))) + ;; Expand `tramp-default-method' and `tramp-default-user'. (should (string-equal (file-remote-p "/[/host#1234]") @@ -4582,15 +4651,19 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (file-equal-p tmp-name1 tmp-name2)) ;; Symbolic links could look like a remote file name. ;; They must be quoted then. - (let ((penguin - (if (eq tramp-syntax 'separate) - "/[penguin/motd]" "/penguin:motd:"))) + (let ((penguin (pcase tramp-syntax + ('default "/penguin:motd:") + ('simplified "/motd:") + ('separate "/[penguin/motd]")))) (delete-file tmp-name2) - (make-symbolic-link - (funcall (if quoted #'file-name-unquote #'identity) penguin) - tmp-name2) - (should (file-symlink-p tmp-name2)) - (should-not (file-regular-p tmp-name2)) + (make-symbolic-link penguin tmp-name2) + (should + (string-equal + (file-attribute-type (file-attributes tmp-name2)) + (file-name-quote penguin 'top))) + (should + (string-equal + (file-symlink-p tmp-name2) (file-name-quote penguin 'top))) (should (string-equal (file-truename tmp-name2)