Bas Alberts of the GitHub Security Lab discovered a local command
execution vulnerability in GNU Emacs 30.2 onwards, and possibly earlier.
I am attaching a fix prepared by Michael Albinus, the TRAMP maintainer.
Here is Bas's description of the problem (edited down a bit).
--8<---------------cut here---------------start------------->8---
1. Tramp: local shell command injection through the user field
(tramp-sh.el, CRITICAL)
tramp-maybe-open-connection builds the login command by expanding
tramp-login-args (%u, %h, ...) and joining the words with
string-join, unquoted, into a command line that is sent to a live
LOCAL shell (tramp-encoding-shell, i.e. /bin/sh) that Tramp has
already spawned for the connection:
- tramp-sh.el:5489-5514 unquoted string-join of login args
- tramp-sh.el:5406-5413 the local shell the string is sent to
tramp-user-regexp (tramp.el:1073) is
(+ (not (any "/:|[]" blank))), which admits $ ( ) ; ` ' " \ and more.
tramp-dissect-file-name performs no sanitization.
Consequence: merely stat-ing a file name such as
/ssh:$(cd;touch$IFS'pwned')@127.0.0.1:/x
e.g. via file-exists-p, executes the $(...) payload in the local
shell during connection setup, before and regardless of any actual
ssh connection or server. The excluded characters are easily worked
around within the allowed charset: $IFS substitutes for blanks,
$(printf$IFS'\057') composes the excluded /, and $(cd;...) sidesteps
absolute paths entirely, so arbitrary commands are expressible.
2. Tramp: file name dispatch regexp is line-anchored, not
string-anchored (tramp.el, CRITICAL enabler)
tramp-build-prefix-regexp (tramp.el:1025-1027) anchors with rx "bol";
the docstring even says the result "Should always start with ^". The
derived tramp-file-name-regexp is what Tramp registers in
file-name-handler-alist once loaded (replacing the string-anchored
tramp-initial-file-name-regexp autoload entry, tramp.el:1284-1288).
Consequence: after Tramp is loaded, any file name merely CONTAINING
newline + "/ssh:..." is dispatched to Tramp handlers, and
tramp-dissect-file-name parses the embedded line, feeding defect 1.
File names cannot contain "/", but two on-disk carriers exist:
a. symlink targets (arbitrary bytes except NUL, committable to
git);
b. a directory whose name ends in a newline, containing a file
named "ssh:...": the path component boundary supplies the "/",
so any code that composes the path (e.g.
directory-files-recursively) produces a string containing
"\n/ssh:...". Verified: recursively scanning such a tree
executes the payload with Tramp loaded.
Additionally, an ABSOLUTE symlink target "/ssh:$(...)@host:/x"
matches even the string-anchored autoload regexp, so no Tramp preload
is required for carrier (a).
--8<---------------cut here---------------end--------------->8---
--
Sean Whitton
Author: Michael Albinus <[email protected]>
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 @@ tramp-gvfs-handle-expand-file-name
(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 @@ tramp-gvfs-get-file-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 @@ tramp-gvfs-handle-file-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 @@ tramp-gvfs-file-name
"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 @@ tramp-gvfs-handler-mounted-unmounted
(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 @@ tramp-gvfs-connection-mounted-p
(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 @@ tramp-gvfs-connection-mounted-p
(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 @@ tramp-gvfs-unmount
(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 @@ tramp-gvfs-mount-spec
(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 @@ tramp-gvfs-mount-spec
(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 @@ tramp-gvfs-mount-spec
((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 @@ tramp-gvfs-mount-spec
,@(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 @@ tramp-rclone-parse-device-names
(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 @@ tramp-rclone-remote-file-name
(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 @@ tramp-smb-get-share
"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 @@ tramp-smb-get-localname
(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 @@ tramp-smb-get-localname
(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 @@ tramp-prefix-format
(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 @@ tramp-postfix-method-regexp
"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 @@ tramp-dissect-file-name
(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 @@ tramp-file-name-handler
;; `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 @@ tramp-convert-file-attributes
(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)
