summaryrefslogtreecommitdiff
path: root/lisp/net
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/net')
-rw-r--r--lisp/net/browse-url.el25
-rw-r--r--lisp/net/dbus.el6
-rw-r--r--lisp/net/dictionary.el44
-rw-r--r--lisp/net/dns.el2
-rw-r--r--lisp/net/eww.el294
-rw-r--r--lisp/net/imap.el8
-rw-r--r--lisp/net/shr.el91
-rw-r--r--lisp/net/sieve.el2
-rw-r--r--lisp/net/tramp-adb.el45
-rw-r--r--lisp/net/tramp-androidsu.el561
-rw-r--r--lisp/net/tramp-archive.el4
-rw-r--r--lisp/net/tramp-cache.el105
-rw-r--r--lisp/net/tramp-cmds.el2
-rw-r--r--lisp/net/tramp-compat.el16
-rw-r--r--lisp/net/tramp-container.el60
-rw-r--r--lisp/net/tramp-gvfs.el7
-rw-r--r--lisp/net/tramp-integration.el2
-rw-r--r--lisp/net/tramp-message.el4
-rw-r--r--lisp/net/tramp-sh.el93
-rw-r--r--lisp/net/tramp-sshfs.el4
-rw-r--r--lisp/net/tramp-sudoedit.el2
-rw-r--r--lisp/net/tramp.el108
-rw-r--r--lisp/net/trampver.el6
23 files changed, 1202 insertions, 289 deletions
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 359453ca433..f22aa19f5e3 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -688,8 +688,10 @@ websites are increasingly rare, but they do still exist."
(defun browse-url-url-at-point ()
(or (thing-at-point 'url t)
;; assume that the user is pointing at something like gnu.org/gnu
- (let ((f (thing-at-point 'filename t)))
- (and f (concat browse-url-default-scheme "://" f)))))
+ (when-let ((f (thing-at-point 'filename t)))
+ (if (string-match-p browse-url-button-regexp f)
+ f
+ (concat browse-url-default-scheme "://" f)))))
;; Having this as a separate function called by the browser-specific
;; functions allows them to be stand-alone commands, making it easier
@@ -702,8 +704,10 @@ it defaults to the current region, else to the URL at or before
point. If invoked with a mouse button, it moves point to the
position clicked before acting.
-This function returns a list (URL NEW-WINDOW-FLAG)
-for use in `interactive'."
+This function returns a list (URL NEW-WINDOW-FLAG) for use in
+`interactive'. NEW-WINDOW-FLAG is the prefix arg; if
+`browse-url-new-window-flag' is non-nil, invert the prefix arg
+instead."
(let ((event (elt (this-command-keys) 0)))
(mouse-set-point event))
(list (read-string prompt (or (and transient-mark-mode mark-active
@@ -713,8 +717,7 @@ for use in `interactive'."
(buffer-substring-no-properties
(region-beginning) (region-end))))
(browse-url-url-at-point)))
- (not (eq (null browse-url-new-window-flag)
- (null current-prefix-arg)))))
+ (xor browse-url-new-window-flag current-prefix-arg)))
;; called-interactive-p needs to be called at a function's top-level, hence
;; this macro. We use that rather than interactive-p because
@@ -877,8 +880,8 @@ The variables `browse-url-browser-function',
`browse-url-handlers', and `browse-url-default-handlers'
determine which browser function to use.
-This command prompts for a URL, defaulting to the URL at or
-before point.
+Interactively, this command prompts for a URL, defaulting to the
+URL at or before point.
The additional ARGS are passed to the browser function. See the
doc strings of the actual functions, starting with
@@ -886,7 +889,9 @@ doc strings of the actual functions, starting with
significance of ARGS (most of the functions ignore it).
If ARGS are omitted, the default is to pass
-`browse-url-new-window-flag' as ARGS."
+`browse-url-new-window-flag' as ARGS. Interactively, pass the
+prefix arg as ARGS; if `browse-url-new-window-flag' is non-nil,
+invert the prefix arg instead."
(interactive (browse-url-interactive-arg "URL: "))
(unless (called-interactively-p 'interactive)
(setq args (or args (list browse-url-new-window-flag))))
@@ -1322,7 +1327,7 @@ and instant messengers instead of opening it in a web browser."
:type 'boolean
:version "30.1")
-(declare-function android-browse-url "androidselect.c")
+(declare-function android-browse-url "../term/android-win")
;;;###autoload
(defun browse-url-default-android-browser (url &optional _new-window)
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 77b334e704e..46f85daba24 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -371,11 +371,7 @@ object is returned instead of a list containing this single Lisp object.
(apply
#'dbus-message-internal dbus-message-type-method-call
bus service path interface method #'dbus-call-method-handler args))
- (result (unless executing-kbd-macro (cons :pending nil))))
-
- ;; While executing a keyboard macro, we run into an infinite loop,
- ;; receiving the event -1. So we don't try to get the result.
- ;; (Bug#62018)
+ (result (cons :pending nil)))
;; Wait until `dbus-call-method-handler' has put the result into
;; `dbus-return-values-table'. If no timeout is given, use the
diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el
index 1981b757017..d4dfa33716c 100644
--- a/lisp/net/dictionary.el
+++ b/lisp/net/dictionary.el
@@ -787,7 +787,7 @@ FUNCTION is the callback which is called for each search result."
Optional argument NOMATCHING controls whether to suppress the display
of matching words."
- (message "Searching for %s in %s" word dictionary)
+ (insert (format-message "Searching for `%s' in `%s'\n" word dictionary))
(dictionary-send-command (concat "define "
(dictionary-encode-charset dictionary "")
" \""
@@ -799,13 +799,13 @@ of matching words."
(if (dictionary-check-reply reply 552)
(progn
(unless nomatching
- (insert "Word not found")
+ (insert (format-message "Word `%s' not found\n" word))
(dictionary-do-matching
word
dictionary
"."
(lambda (reply)
- (insert ", maybe you are looking for one of these words\n\n")
+ (insert "Maybe you are looking for one of these words\n")
(dictionary-display-only-match-result reply)))
(dictionary-post-buffer)))
(if (dictionary-check-reply reply 550)
@@ -1116,20 +1116,26 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
(defun dictionary-new-matching (word)
"Run a new matching search on WORD."
- (dictionary-ensure-buffer)
(dictionary-store-positions)
- (dictionary-do-matching word dictionary-default-dictionary
- dictionary-default-strategy
- 'dictionary-display-match-result)
- (dictionary-store-state 'dictionary-do-matching
+ (dictionary-ensure-buffer)
+ (dictionary-new-matching-internal word dictionary-default-dictionary
+ dictionary-default-strategy
+ 'dictionary-display-match-result)
+ (dictionary-store-state 'dictionary-new-matching-internal
(list word dictionary-default-dictionary
dictionary-default-strategy
'dictionary-display-match-result)))
+(defun dictionary-new-matching-internal (word dictionary strategy function)
+ "Start a new matching for WORD in DICTIONARY after preparing the buffer.
+FUNCTION is the callback which is called for each search result."
+ (dictionary-pre-buffer)
+ (dictionary-do-matching word dictionary strategy function))
+
(defun dictionary-do-matching (word dictionary strategy function)
"Search for WORD with STRATEGY in DICTIONARY and display them with FUNCTION."
- (message "Lookup matching words for %s in %s using %s"
- word dictionary strategy)
+ (insert (format-message "Lookup matching words for `%s' in `%s' using `%s'\n"
+ word dictionary strategy))
(dictionary-send-command
(concat "match " (dictionary-encode-charset dictionary "") " "
(dictionary-encode-charset strategy "") " \""
@@ -1141,10 +1147,13 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
(if (dictionary-check-reply reply 551)
(error "Strategy \"%s\" is invalid" strategy))
(if (dictionary-check-reply reply 552)
- (error (concat
- "No match for \"%s\" with strategy \"%s\" in "
- "dictionary \"%s\".")
- word strategy dictionary))
+ (let ((errmsg (format-message
+ (concat
+ "No match for `%s' with strategy `%s' in "
+ "dictionary `%s'.")
+ word strategy dictionary)))
+ (insert errmsg "\n")
+ (user-error errmsg)))
(unless (dictionary-check-reply reply 152)
(error "Unknown server answer: %s" (dictionary-reply reply)))
(funcall function reply)))
@@ -1172,8 +1181,6 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
(defun dictionary-display-match-result (reply)
"Display the results in REPLY from a match operation."
- (dictionary-pre-buffer)
-
(let ((number (nth 1 (dictionary-reply-list reply)))
(list (dictionary-simple-split-string (dictionary-read-answer) "\n+")))
(insert number " matching word" (if (equal number "1") "" "s")
@@ -1271,7 +1278,7 @@ prompt for DICTIONARY."
(interactive)
(let ((word (current-word)))
(unless word
- (error "No word at point"))
+ (user-error "No word at point"))
(dictionary-new-search (cons word dictionary-default-dictionary))))
(defun dictionary-previous ()
@@ -1311,7 +1318,8 @@ prompt for DICTIONARY."
(defun dictionary-popup-matching-words (&optional word)
"Display entries matching WORD or the current word if not given."
(interactive)
- (dictionary-do-matching (or word (current-word) (error "Nothing to search for"))
+ (dictionary-do-matching (or word (current-word)
+ (user-error "Nothing to search for"))
dictionary-default-dictionary
dictionary-default-popup-strategy
'dictionary-process-popup-replies))
diff --git a/lisp/net/dns.el b/lisp/net/dns.el
index 23ea88ef4ad..54f4d227a49 100644
--- a/lisp/net/dns.el
+++ b/lisp/net/dns.el
@@ -359,7 +359,7 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"."
result))
;;; Interface functions.
-(defvar dns-cache (make-vector 4096 0))
+(defvar dns-cache (obarray-make 4096))
(defun dns-query-cached (name &optional type fullp reversep)
(let* ((key (format "%s:%s:%s:%s" name type fullp reversep))
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 22f07cbc5b4..39ea964d47a 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -182,6 +182,33 @@ the tab bar is enabled."
(const :tag "Open new tab when tab bar is enabled" tab-bar)
(const :tag "Never open URL in new tab" nil)))
+(defcustom eww-before-browse-history-function #'eww-delete-future-history
+ "A function to call to update history before browsing to a new page.
+EWW provides the following values for this option:
+
+* `eww-delete-future-history': Delete any history entries after the
+ currently-shown one. This is the default behavior, and works the same
+ as in most other web browsers.
+
+* `eww-clone-previous-history': Clone and prepend any history entries up
+ to the currently-shown one. This is like `eww-delete-future-history',
+ except that it preserves the previous contents of the history list at
+ the end.
+
+* `ignore': Preserve the current history unchanged. This will result in
+ the new page simply being prepended to the existing history list.
+
+You can also set this to any other function you wish."
+ :version "30.1"
+ :group 'eww
+ :type '(choice (function-item :tag "Delete future history"
+ eww-delete-future-history)
+ (function-item :tag "Clone previous history"
+ eww-clone-previous-history)
+ (function-item :tag "Preserve history"
+ ignore)
+ (function :tag "Custom function")))
+
(defcustom eww-after-render-hook nil
"A hook called after eww has finished rendering the buffer."
:version "25.1"
@@ -248,6 +275,27 @@ parameter, and should return the (possibly) transformed URL."
:type '(repeat function)
:version "29.1")
+(defcustom eww-readable-urls nil
+ "A list of regexps matching URLs to display in readable mode by default.
+EWW will display matching URLs using `eww-readable' (which see).
+
+Each element can be one of the following forms: a regular expression in
+string form or a cons cell of the form (REGEXP . READABILITY). If
+READABILITY is non-nil, this behaves the same as the string form;
+otherwise, URLs matching REGEXP will never be displayed in readable mode
+by default."
+ :type '(repeat (choice (string :tag "Readable URL")
+ (cons :tag "URL and Readability"
+ (string :tag "URL")
+ (radio (const :tag "Readable" t)
+ (const :tag "Non-readable" nil)))))
+ :version "30.1")
+
+(defcustom eww-readable-adds-to-history t
+ "If non-nil, calling `eww-readable' adds a new entry to the history."
+ :type 'boolean
+ :version "30.1")
+
(defface eww-form-submit
'((((type x w32 ns haiku pgtk android) (class color)) ; Like default mode line
:box (:line-width 2 :style released-button)
@@ -312,7 +360,10 @@ parameter, and should return the (possibly) transformed URL."
(defvar eww-data nil)
(defvar eww-history nil)
-(defvar eww-history-position 0)
+(defvar eww-history-position 0
+ "The 1-indexed position in `eww-history'.
+If zero, EWW is at the newest page, which isn't yet present in
+`eww-history'.")
(defvar eww-prompt-history nil)
(defvar eww-local-regex "localhost"
@@ -340,7 +391,7 @@ parameter, and should return the (possibly) transformed URL."
(defun eww-suggested-uris nil
"Return the list of URIs to suggest at the `eww' prompt.
This list can be customized via `eww-suggest-uris'."
- (let ((obseen (make-vector 42 0))
+ (let ((obseen (obarray-make 42))
(uris nil))
(dolist (fun eww-suggest-uris)
(let ((ret (funcall fun)))
@@ -402,6 +453,7 @@ For more information, see Info node `(eww) Top'."
(t
(get-buffer-create "*eww*"))))
(eww-setup-buffer)
+ (eww--before-browse)
;; Check whether the domain only uses "Highly Restricted" Unicode
;; IDNA characters. If not, transform to punycode to indicate that
;; there may be funny business going on.
@@ -433,11 +485,11 @@ For more information, see Info node `(eww) Top'."
(defun eww-retrieve (url callback cbargs)
(cond
((null eww-retrieve-command)
- (url-retrieve url #'eww-render cbargs))
+ (url-retrieve url callback cbargs))
((eq eww-retrieve-command 'sync)
(let ((data-buffer (url-retrieve-synchronously url)))
(with-current-buffer data-buffer
- (apply #'eww-render nil url cbargs))))
+ (apply callback nil cbargs))))
(t
(let ((buffer (generate-new-buffer " *eww retrieve*"))
(error-buffer (generate-new-buffer " *eww error*")))
@@ -642,9 +694,9 @@ The renaming scheme is performed in accordance with
(insert (format "<a href=%S>Direct link to the document</a>"
url))
(goto-char (point-min))
- (eww-display-html charset url nil point buffer encode))
+ (eww-display-html (or encode charset) url nil point buffer))
((eww-html-p (car content-type))
- (eww-display-html charset url nil point buffer encode))
+ (eww-display-html (or encode charset) url nil point buffer))
((equal (car content-type) "application/pdf")
(eww-display-pdf))
((string-match-p "\\`image/" (car content-type))
@@ -654,7 +706,6 @@ The renaming scheme is performed in accordance with
(with-current-buffer buffer
(plist-put eww-data :url url)
(eww--after-page-change)
- (setq eww-history-position 0)
(and last-coding-system-used
(set-buffer-file-coding-system last-coding-system-used))
(unless shr-fill-text
@@ -696,34 +747,40 @@ The renaming scheme is performed in accordance with
(declare-function libxml-parse-html-region "xml.c"
(start end &optional base-url discard-comments))
-(defun eww-display-html (charset url &optional document point buffer encode)
+(defun eww--parse-html-region (start end &optional coding-system)
+ "Parse the HTML between START and END, returning the DOM as an S-expression.
+Use CODING-SYSTEM to decode the region; if nil, decode as UTF-8.
+
+This replaces the region with the preprocessed HTML."
+ (setq coding-system (or coding-system 'utf-8))
+ (with-restriction start end
+ (condition-case nil
+ (decode-coding-region (point-min) (point-max) coding-system)
+ (coding-system-error nil))
+ ;; Remove CRLF and replace NUL with &#0; before parsing.
+ (while (re-search-forward "\\(\r$\\)\\|\0" nil t)
+ (replace-match (if (match-beginning 1) "" "&#0;") t t))
+ (eww--preprocess-html (point-min) (point-max))
+ (libxml-parse-html-region (point-min) (point-max))))
+
+(defsubst eww-document-base (url dom)
+ `(base ((href . ,url)) ,dom))
+
+(defun eww-display-document (document &optional point buffer)
(unless (fboundp 'libxml-parse-html-region)
(error "This function requires Emacs to be compiled with libxml2"))
+ (setq buffer (or buffer (current-buffer)))
(unless (buffer-live-p buffer)
(error "Buffer %s doesn't exist" buffer))
;; There should be a better way to abort loading images
;; asynchronously.
(setq url-queue nil)
- (let ((document
- (or document
- (list
- 'base (list (cons 'href url))
- (progn
- (setq encode (or encode charset 'utf-8))
- (condition-case nil
- (decode-coding-region (point) (point-max) encode)
- (coding-system-error nil))
- (save-excursion
- ;; Remove CRLF and replace NUL with &#0; before parsing.
- (while (re-search-forward "\\(\r$\\)\\|\0" nil t)
- (replace-match (if (match-beginning 1) "" "&#0;") t t)))
- (eww--preprocess-html (point) (point-max))
- (libxml-parse-html-region (point) (point-max))))))
- (source (and (null document)
- (buffer-substring (point) (point-max)))))
+ (let ((url (when (eq (car document) 'base)
+ (alist-get 'href (cadr document)))))
+ (unless url
+ (error "Document is missing base URL"))
(with-current-buffer buffer
(setq bidi-paragraph-direction nil)
- (plist-put eww-data :source source)
(plist-put eww-data :dom document)
(let ((inhibit-read-only t)
(inhibit-modification-hooks t)
@@ -764,6 +821,20 @@ The renaming scheme is performed in accordance with
(forward-line 1)))))
(eww-size-text-inputs))))
+(defun eww-display-html (charset url &optional document point buffer)
+ (let ((source (buffer-substring (point) (point-max))))
+ (with-current-buffer buffer
+ (plist-put eww-data :source source)))
+ (unless document
+ (let ((dom (eww--parse-html-region (point) (point-max) charset)))
+ (when (eww-default-readable-p url)
+ (eww-score-readability dom)
+ (setq dom (eww-highest-readability dom))
+ (with-current-buffer buffer
+ (plist-put eww-data :readable t)))
+ (setq document (eww-document-base url dom))))
+ (eww-display-document document point buffer))
+
(defun eww-handle-link (dom)
(let* ((rel (dom-attr dom 'rel))
(href (dom-attr dom 'href))
@@ -905,6 +976,11 @@ The renaming scheme is performed in accordance with
`((?u . ,(or url ""))
(?t . ,title))))))))
+(defun eww--before-browse ()
+ (funcall eww-before-browse-history-function)
+ (setq eww-history-position 0
+ eww-data (list :title "")))
+
(defun eww--after-page-change ()
(eww-update-header-line-format)
(eww--rename-buffer))
@@ -1020,29 +1096,47 @@ The renaming scheme is performed in accordance with
"automatic"
bidi-paragraph-direction)))
-(defun eww-readable ()
- "View the main \"readable\" parts of the current web page.
+(defun eww-readable (&optional arg)
+ "Toggle display of only the main \"readable\" parts of the current web page.
This command uses heuristics to find the parts of the web page that
-contains the main textual portion, leaving out navigation menus and
-the like."
- (interactive nil eww-mode)
+contain the main textual portion, leaving out navigation menus and the
+like.
+
+If called interactively, toggle the display of the readable parts. If
+the prefix argument is positive, display the readable parts, and if it
+is zero or negative, display the full page.
+
+If called from Lisp, toggle the display of the readable parts if ARG is
+`toggle'. Display the readable parts if ARG is nil, omitted, or is a
+positive number. Display the full page if ARG is a negative number.
+
+When `eww-readable-adds-to-history' is non-nil, calling this function
+adds a new entry to `eww-history'."
+ (interactive (list (if current-prefix-arg
+ (prefix-numeric-value current-prefix-arg)
+ 'toggle))
+ eww-mode)
(let* ((old-data eww-data)
- (dom (with-temp-buffer
+ (make-readable (cond
+ ((eq arg 'toggle)
+ (not (plist-get old-data :readable)))
+ ((and (numberp arg) (< arg 1))
+ nil)
+ (t t)))
+ (dom (with-temp-buffer
(insert (plist-get old-data :source))
- (condition-case nil
- (decode-coding-region (point-min) (point-max) 'utf-8)
- (coding-system-error nil))
- (eww--preprocess-html (point-min) (point-max))
- (libxml-parse-html-region (point-min) (point-max))))
+ (eww--parse-html-region (point-min) (point-max))))
(base (plist-get eww-data :url)))
- (eww-score-readability dom)
- (eww-save-history)
- (eww-display-html nil nil
- (list 'base (list (cons 'href base))
- (eww-highest-readability dom))
- nil (current-buffer))
- (dolist (elem '(:source :url :title :next :previous :up :peer))
- (plist-put eww-data elem (plist-get old-data elem)))
+ (when make-readable
+ (eww-score-readability dom)
+ (setq dom (eww-highest-readability dom)))
+ (when eww-readable-adds-to-history
+ (eww-save-history)
+ (eww--before-browse)
+ (dolist (elem '(:source :url :title :next :previous :up :peer))
+ (plist-put eww-data elem (plist-get old-data elem))))
+ (eww-display-document (eww-document-base base dom))
+ (plist-put eww-data :readable make-readable)
(eww--after-page-change)))
(defun eww-score-readability (node)
@@ -1085,6 +1179,19 @@ the like."
(setq result highest))))
result))
+(defun eww-default-readable-p (url)
+ "Return non-nil if URL should be displayed in readable mode by default.
+This consults the entries in `eww-readable-urls' (which see)."
+ (catch 'found
+ (let (result)
+ (dolist (regexp eww-readable-urls)
+ (if (consp regexp)
+ (setq result (cdr regexp)
+ regexp (car regexp))
+ (setq result t))
+ (when (string-match regexp url)
+ (throw 'found result))))))
+
(defvar-keymap eww-mode-map
"g" #'eww-reload ;FIXME: revert-buffer-function instead!
"G" #'eww
@@ -1129,9 +1236,9 @@ the like."
["Reload" eww-reload t]
["Follow URL in new buffer" eww-open-in-new-buffer]
["Back to previous page" eww-back-url
- :active (not (zerop (length eww-history)))]
+ :active (< eww-history-position (length eww-history))]
["Forward to next page" eww-forward-url
- :active (not (zerop eww-history-position))]
+ :active (> eww-history-position 1)]
["Browse with external browser" eww-browse-with-external-browser t]
["Download" eww-download t]
["View page source" eww-view-source]
@@ -1155,9 +1262,9 @@ the like."
(easy-menu-define nil easy-menu nil
'("Eww"
["Back to previous page" eww-back-url
- :visible (not (zerop (length eww-history)))]
+ :active (< eww-history-position (length eww-history))]
["Forward to next page" eww-forward-url
- :visible (not (zerop eww-history-position))]
+ :active (> eww-history-position 1)]
["Reload" eww-reload t]))
(dolist (item (reverse (lookup-key easy-menu [menu-bar eww])))
(when (consp item)
@@ -1280,16 +1387,20 @@ instead of `browse-url-new-window-flag'."
(interactive nil eww-mode)
(when (>= eww-history-position (length eww-history))
(user-error "No previous page"))
- (eww-save-history)
- (setq eww-history-position (+ eww-history-position 2))
+ (if (eww-save-history)
+ ;; We were at the latest page (which was just added to the
+ ;; history), so go back two entries.
+ (setq eww-history-position 2)
+ (setq eww-history-position (1+ eww-history-position)))
(eww-restore-history (elt eww-history (1- eww-history-position))))
(defun eww-forward-url ()
"Go to the next displayed page."
(interactive nil eww-mode)
- (when (zerop eww-history-position)
+ (when (<= eww-history-position 1)
(user-error "No next page"))
(eww-save-history)
+ (setq eww-history-position (1- eww-history-position))
(eww-restore-history (elt eww-history (1- eww-history-position))))
(defun eww-restore-history (elem)
@@ -1358,8 +1469,7 @@ just re-display the HTML already fetched."
(if local
(if (null (plist-get eww-data :dom))
(error "No current HTML data")
- (eww-display-html 'utf-8 url (plist-get eww-data :dom)
- (point) (current-buffer)))
+ (eww-display-document (plist-get eww-data :dom) (point)))
(let ((parsed (url-generic-parse-url url)))
(if (equal (url-type parsed) "file")
;; Use Tramp instead of url.el for files (since url.el
@@ -1959,6 +2069,7 @@ If EXTERNAL is double prefix, browse in new buffer."
(eww-same-page-p url (plist-get eww-data :url)))
(let ((point (point)))
(eww-save-history)
+ (eww--before-browse)
(plist-put eww-data :url url)
(goto-char (point-min))
(if-let ((match (text-property-search-forward 'shr-target-id target #'member)))
@@ -2064,9 +2175,10 @@ If CHARSET is nil then use UTF-8."
"Prompt for an EWW buffer to display in the selected window."
(interactive nil eww-mode)
(let ((completion-extra-properties
- '(:annotation-function (lambda (buf)
- (with-current-buffer buf
- (format " %s" (eww-current-url))))))
+ `(:annotation-function
+ ,(lambda (buf)
+ (with-current-buffer buf
+ (format " %s" (eww-current-url))))))
(curbuf (current-buffer)))
(pop-to-buffer-same-window
(read-buffer "Switch to EWW buffer: "
@@ -2225,7 +2337,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks."
(setq first t)
(eww-read-bookmarks t)
(eww-bookmark-prepare))
- (with-current-buffer (get-buffer "*eww bookmarks*")
+ (with-current-buffer "*eww bookmarks*"
(when (and (not first)
(not (eobp)))
(forward-line 1))
@@ -2244,7 +2356,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks."
(setq first t)
(eww-read-bookmarks t)
(eww-bookmark-prepare))
- (with-current-buffer (get-buffer "*eww bookmarks*")
+ (with-current-buffer "*eww bookmarks*"
(if first
(goto-char (point-max))
(beginning-of-line))
@@ -2288,11 +2400,69 @@ If ERROR-OUT, signal user-error if there are no bookmarks."
;;; History code
(defun eww-save-history ()
+ "Save the current page's data to the history.
+If the current page is a historial one loaded from
+`eww-history' (e.g. by calling `eww-back-url'), this will update the
+page's entry in `eww-history' and return nil. Otherwise, add a new
+entry to `eww-history' and return t."
(plist-put eww-data :point (point))
(plist-put eww-data :text (buffer-string))
- (let ((history-delete-duplicates nil))
- (add-to-history 'eww-history eww-data eww-history-limit t))
- (setq eww-data (list :title "")))
+ (if (zerop eww-history-position)
+ (let ((history-delete-duplicates nil))
+ (add-to-history 'eww-history eww-data eww-history-limit t)
+ (setq eww-history-position 1)
+ t)
+ (setf (elt eww-history (1- eww-history-position)) eww-data)
+ nil))
+
+(defun eww-delete-future-history ()
+ "Remove any entries in `eww-history' after the currently-shown one.
+This is useful for `eww-before-browse-history-function' to make EWW's
+navigation to a new page from a historical one work like other web
+browsers: it will delete any \"future\" history elements before adding
+the new page to the end of the history.
+
+For example, if `eww-history' looks like this (going from newest to
+oldest, with \"*\" marking the current page):
+
+ E D C* B A
+
+then calling this function updates `eww-history' to:
+
+ C* B A"
+ (when (> eww-history-position 1)
+ (setq eww-history (nthcdr (1- eww-history-position) eww-history)
+ ;; We don't really need to set this since `eww--before-browse'
+ ;; sets it too, but this ensures that other callers can use
+ ;; this function and get the expected results.
+ eww-history-position 1)))
+
+(defun eww-clone-previous-history ()
+ "Clone and prepend entries in `eww-history' up to the currently-shown one.
+These cloned entries get added to the beginning of `eww-history' so that
+it's possible to navigate back to the very first page for this EWW
+without deleting any history entries.
+
+For example, if `eww-history' looks like this (going from newest to
+oldest, with \"*\" marking the current page):
+
+ E D C* B A
+
+then calling this function updates `eww-history' to:
+
+ C* B A E D C B A
+
+This is useful for setting `eww-before-browse-history-function' (which
+see)."
+ (when (> eww-history-position 1)
+ (setq eww-history (take eww-history-limit
+ (append (nthcdr (1- eww-history-position)
+ eww-history)
+ eww-history))
+ ;; As with `eww-delete-future-history', we don't really need
+ ;; to set this since `eww--before-browse' sets it too, but
+ ;; let's be thorough.
+ eww-history-position 1)))
(defvar eww-current-buffer)
diff --git a/lisp/net/imap.el b/lisp/net/imap.el
index f10b5b8fc12..a06740528e9 100644
--- a/lisp/net/imap.el
+++ b/lisp/net/imap.el
@@ -1057,7 +1057,7 @@ necessary. If nil, the buffer name is generated."
(setq imap-capability nil)
(setq streams nil))))))
(when (imap-opened buffer)
- (setq imap-mailbox-data (make-vector imap-mailbox-prime 0)))
+ (setq imap-mailbox-data (obarray-make imap-mailbox-prime)))
;; (debug "opened+state+auth+buffer" (imap-opened buffer) imap-state imap-auth buffer)
(when imap-stream
buffer))))
@@ -1280,7 +1280,7 @@ If EXAMINE is non-nil, do a read-only select."
(concat (if examine "EXAMINE" "SELECT") " \""
mailbox "\"")))
(progn
- (setq imap-message-data (make-vector imap-message-prime 0)
+ (setq imap-message-data (obarray-make imap-message-prime)
imap-state (if examine 'examine 'selected))
imap-current-mailbox)
;; Failed SELECT/EXAMINE unselects current mailbox
@@ -1722,7 +1722,7 @@ See `imap-enable-exchange-bug-workaround'."
(string-to-number (nth 2 (imap-mailbox-get-1 'copyuid mailbox))))
(let ((old-mailbox imap-current-mailbox)
(state imap-state)
- (imap-message-data (make-vector 2 0)))
+ (imap-message-data (obarray-make 2)))
(when (imap-mailbox-examine-1 mailbox)
(prog1
(and (imap-fetch-safe '("*" . "*:*") "UID")
@@ -1768,7 +1768,7 @@ first element. The rest of list contains the saved articles' UIDs."
(imap-mailbox-get-1 'appenduid mailbox)
(let ((old-mailbox imap-current-mailbox)
(state imap-state)
- (imap-message-data (make-vector 2 0)))
+ (imap-message-data (obarray-make 2)))
(when (imap-mailbox-examine-1 mailbox)
(prog1
(and (imap-fetch-safe '("*" . "*:*") "UID")
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 17fdffd619d..09df5f5a9bb 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -784,8 +784,9 @@ size, and full-buffer size."
(or shr-current-font 'shr-text)))))))))
(defun shr-fill-lines (start end)
- (if (or (not shr-fill-text) (<= shr-internal-width 0))
- nil
+ "Indent and fill text from START to END.
+When `shr-fill-text' is nil, only indent."
+ (unless (<= shr-internal-width 0)
(save-restriction
(narrow-to-region start end)
(goto-char start)
@@ -807,6 +808,8 @@ size, and full-buffer size."
(forward-char 1))))
(defun shr-fill-line ()
+ "Indent and fill the current line.
+When `shr-fill-text' is nil, only indent."
(let ((shr-indentation (or (get-text-property (point) 'shr-indentation)
shr-indentation))
(continuation (get-text-property
@@ -821,9 +824,11 @@ size, and full-buffer size."
`,(shr-face-background face))))
(setq start (point))
(setq shr-indentation (or continuation shr-indentation))
- ;; If we have an indentation that's wider than the width we're
- ;; trying to fill to, then just give up and don't do any filling.
- (when (< shr-indentation shr-internal-width)
+ ;; Fill the current line, unless `shr-fill-text' is unset, or we
+ ;; have an indentation that's wider than the width we're trying to
+ ;; fill to.
+ (when (and shr-fill-text
+ (< shr-indentation shr-internal-width))
(shr-vertical-motion shr-internal-width)
(when (looking-at " $")
(delete-region (point) (line-end-position)))
@@ -1437,13 +1442,85 @@ ones, in case fg and bg are nil."
(shr-dom-print elem)))))
(insert (format "</%s>" (dom-tag dom))))
+(defconst shr-correct-attribute-case
+ '((attributename . attributeName)
+ (attributetype . attributeType)
+ (basefrequency . baseFrequency)
+ (baseprofile . baseProfile)
+ (calcmode . calcMode)
+ (clippathunits . clipPathUnits)
+ (diffuseconstant . diffuseConstant)
+ (edgemode . edgeMode)
+ (filterunits . filterUnits)
+ (glyphref . glyphRef)
+ (gradienttransform . gradientTransform)
+ (gradientunits . gradientUnits)
+ (kernelmatrix . kernelMatrix)
+ (kernelunitlength . kernelUnitLength)
+ (keypoints . keyPoints)
+ (keysplines . keySplines)
+ (keytimes . keyTimes)
+ (lengthadjust . lengthAdjust)
+ (limitingconeangle . limitingConeAngle)
+ (markerheight . markerHeight)
+ (markerunits . markerUnits)
+ (markerwidth . markerWidth)
+ (maskcontentunits . maskContentUnits)
+ (maskunits . maskUnits)
+ (numoctaves . numOctaves)
+ (pathlength . pathLength)
+ (patterncontentunits . patternContentUnits)
+ (patterntransform . patternTransform)
+ (patternunits . patternUnits)
+ (pointsatx . pointsAtX)
+ (pointsaty . pointsAtY)
+ (pointsatz . pointsAtZ)
+ (preservealpha . preserveAlpha)
+ (preserveaspectratio . preserveAspectRatio)
+ (primitiveunits . primitiveUnits)
+ (refx . refX)
+ (refy . refY)
+ (repeatcount . repeatCount)
+ (repeatdur . repeatDur)
+ (requiredextensions . requiredExtensions)
+ (requiredfeatures . requiredFeatures)
+ (specularconstant . specularConstant)
+ (specularexponent . specularExponent)
+ (spreadmethod . spreadMethod)
+ (startoffset . startOffset)
+ (stddeviation . stdDeviation)
+ (stitchtiles . stitchTiles)
+ (surfacescale . surfaceScale)
+ (systemlanguage . systemLanguage)
+ (tablevalues . tableValues)
+ (targetx . targetX)
+ (targety . targetY)
+ (textlength . textLength)
+ (viewbox . viewBox)
+ (viewtarget . viewTarget)
+ (xchannelselector . xChannelSelector)
+ (ychannelselector . yChannelSelector)
+ (zoomandpan . zoomAndPan))
+ "Attributes for correcting the case in SVG and MathML.
+Based on https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-inforeign .")
+
+(defun shr-correct-dom-case (dom)
+ "Correct the case for SVG segments."
+ (dolist (attr (dom-attributes dom))
+ (when-let ((rep (assoc-default (car attr) shr-correct-attribute-case)))
+ (setcar attr rep)))
+ (dolist (child (dom-children dom))
+ (shr-correct-dom-case child))
+ dom)
+
(defun shr-tag-svg (dom)
(when (and (image-type-available-p 'svg)
(not shr-inhibit-images)
(dom-attr dom 'width)
(dom-attr dom 'height))
- (funcall shr-put-image-function (list (shr-dom-to-xml dom 'utf-8)
- 'image/svg+xml)
+ (funcall shr-put-image-function
+ (list (shr-dom-to-xml (shr-correct-dom-case dom) 'utf-8)
+ 'image/svg+xml)
"SVG Image")))
(defun shr-tag-sup (dom)
diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el
index fddc6e21bcc..a6ba556e7ae 100644
--- a/lisp/net/sieve.el
+++ b/lisp/net/sieve.el
@@ -354,7 +354,7 @@ Used to bracket operations which move point in the sieve-buffer."
(let ((script (buffer-string))
(script-name (file-name-sans-extension (buffer-name)))
err)
- (with-current-buffer (get-buffer sieve-buffer)
+ (with-current-buffer sieve-buffer
(setq err (sieve-manage-putscript
(or name sieve-buffer-script-name script-name)
script sieve-manage-buffer))
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 2e4ad1cc412..da23d062c2e 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -263,9 +263,10 @@ arguments to pass to the OPERATION."
(tramp-convert-file-attributes v localname id-format
(and
(tramp-adb-send-command-and-check
- v (format "%s -d -l %s | cat"
+ v (format "(%s -d -l %s; echo tramp_exit_status $?) | cat"
(tramp-adb-get-ls-command v)
- (tramp-shell-quote-argument localname)))
+ (tramp-shell-quote-argument localname))
+ nil t)
(with-current-buffer (tramp-get-buffer v)
(tramp-adb-sh-fix-ls-output)
(cdar (tramp-do-parse-file-attributes-with-ls v)))))))
@@ -316,9 +317,10 @@ arguments to pass to the OPERATION."
directory full match nosort id-format count
(with-current-buffer (tramp-get-buffer v)
(when (tramp-adb-send-command-and-check
- v (format "%s -a -l %s | cat"
+ v (format "(%s -a -l %s; echo tramp_exit_status $?) | cat"
(tramp-adb-get-ls-command v)
- (tramp-shell-quote-argument localname)))
+ (tramp-shell-quote-argument localname))
+ nil t)
;; We insert also filename/. and filename/.., because "ls"
;; doesn't on some file systems, like "sdcard".
(unless (search-backward-regexp (rx "." eol) nil t)
@@ -440,10 +442,12 @@ Emacs dired can't find files."
filename
(with-parsed-tramp-file-name (expand-file-name directory) nil
(with-tramp-file-property v localname "file-name-all-completions"
- (tramp-adb-send-command
- v (format "%s -a %s | cat"
- (tramp-adb-get-ls-command v)
- (tramp-shell-quote-argument localname)))
+ (unless (tramp-adb-send-command-and-check
+ v (format "(%s -a %s; echo tramp_exit_status $?) | cat"
+ (tramp-adb-get-ls-command v)
+ (tramp-shell-quote-argument localname))
+ nil t)
+ (erase-buffer))
(mapcar
(lambda (f)
(if (file-directory-p (expand-file-name f directory))
@@ -504,12 +508,11 @@ Emacs dired can't find files."
(with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-writable-p"
(if (file-exists-p filename)
- ;; Examine `file-attributes' cache to see if request can be
- ;; satisfied without remote operation.
- (if (tramp-file-property-p v localname "file-attributes")
- (tramp-check-cached-permissions v ?w)
- (tramp-adb-send-command-and-check
- v (format "test -w %s" (tramp-shell-quote-argument localname))))
+ ;; The file-attributes cache is unreliable since its
+ ;; information does not take partition writability into
+ ;; account, so a call to test must never be skipped.
+ (tramp-adb-send-command-and-check
+ v (format "test -w %s" (tramp-shell-quote-argument localname)))
;; If file doesn't exist, check if directory is writable.
(and
(file-directory-p (file-name-directory filename))
@@ -1142,17 +1145,23 @@ error and non-nil on success."
(while (search-forward-regexp (rx (+ "\r") eol) nil t)
(replace-match "" nil nil)))))))
-(defun tramp-adb-send-command-and-check (vec command &optional exit-status)
+(defun tramp-adb-send-command-and-check
+ (vec command &optional exit-status command-augmented-p)
"Run COMMAND and check its exit status.
Sends `echo $?' along with the COMMAND for checking the exit
status. If COMMAND is nil, just sends `echo $?'. Returns nil if
the exit status is not equal 0, and t otherwise.
+If COMMAND-AUGMENTED-P, COMMAND is already configured to print exit
+status upon completion and need not be modified.
+
Optional argument EXIT-STATUS, if non-nil, triggers the return of
the exit status."
(tramp-adb-send-command
vec (if command
- (format "%s; echo tramp_exit_status $?" command)
+ (if command-augmented-p
+ command
+ (format "%s; echo tramp_exit_status $?" command))
"echo tramp_exit_status $?"))
(with-current-buffer (tramp-get-connection-buffer vec)
(unless (tramp-search-regexp (rx "tramp_exit_status " (+ digit)))
@@ -1230,7 +1239,7 @@ connection if a previous connection has died for some reason."
(let* ((coding-system-for-read 'utf-8-dos) ; Is this correct?
(process-connection-type tramp-process-connection-type)
(args (tramp-expand-args
- vec 'tramp-login-args ?d (or device "")))
+ vec 'tramp-login-args nil ?d (or device "")))
(p (let ((default-directory
tramp-compat-temporary-file-directory))
(apply
@@ -1257,7 +1266,7 @@ connection if a previous connection has died for some reason."
(tramp-set-connection-property
p "prompt" (rx "///" (literal prompt) "#$"))
(tramp-adb-send-command
- vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt))
+ vec (format "PS1=\"///\"\"%s\"\"#$\" PS2=''" prompt))
;; Disable line editing.
(tramp-adb-send-command
diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el
new file mode 100644
index 00000000000..09bee323f5e
--- /dev/null
+++ b/lisp/net/tramp-androidsu.el
@@ -0,0 +1,561 @@
+;;; tramp-androidsu.el --- Tramp method for Android superuser shells -*- lexical-binding:t -*-
+
+;; Copyright (C) 2024 Free Software Foundation, Inc.
+
+;; Author: Po Lu
+;; Keywords: comm, processes
+;; Package: tramp
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; `su' method implementation for Android.
+;;
+;; The `su' method struggles (as do other shell-based methods) with the
+;; crippled versions of many Unix utilities installed on Android,
+;; workarounds for which are implemented in the `adb' method. This
+;; method defines a shell-based method that is identical in function to
+;; and replaces if connecting to a local Android machine `su', but
+;; reuses such code from the `adb' method where applicable and also
+;; provides for certain mannerisms of popular Android `su'
+;; implementations.
+
+;;; Code:
+
+(require 'tramp)
+(require 'tramp-adb)
+(require 'tramp-sh)
+
+;;;###tramp-autoload
+(defconst tramp-androidsu-method "androidsu"
+ "When this method name is used, forward all calls to su.")
+
+;;;###tramp-autoload
+(defcustom tramp-androidsu-mount-global-namespace t
+ "When non-nil, browse files from within the global mount namespace.
+On systems that assign each application a unique view of the
+filesystem by executing them within individual mount namespaces
+and thus conceal each application's data directories from
+others, invoke `su' with the option `-mm' in order for the shell
+launched to run within the global mount namespace, so that Tramp
+may edit files belonging to any and all applications."
+ :group 'tramp
+ :version "30.1"
+ :type 'boolean)
+
+;;;###tramp-autoload
+(defcustom tramp-androidsu-remote-path '("/system/bin"
+ "/system/xbin")
+ "Directories in which to search for transfer programs and the like."
+ :group 'tramp
+ :version "30.1"
+ :type '(list string))
+
+(defvar tramp-androidsu-su-mm-supported 'unknown
+ "Whether `su -mm' is supported on this system.")
+
+;;;###tramp-autoload
+(defconst tramp-androidsu-local-shell-name "/system/bin/sh"
+ "Name of the local shell on Android.")
+
+;;;###tramp-autoload
+(defconst tramp-androidsu-local-tmp-directory "/data/local/tmp"
+ "Name of the local temporary directory on Android.")
+
+;;;###tramp-autoload
+(tramp--with-startup
+ (add-to-list 'tramp-methods
+ `(,tramp-androidsu-method
+ (tramp-login-program "su")
+ (tramp-login-args (("-") ("%u")))
+ (tramp-remote-shell ,tramp-androidsu-local-shell-name)
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))
+ (tramp-tmpdir ,tramp-androidsu-local-tmp-directory)
+ (tramp-connection-timeout 10)
+ (tramp-shell-name ,tramp-androidsu-local-shell-name)))
+ (add-to-list 'tramp-default-user-alist
+ `(,tramp-androidsu-method nil ,tramp-root-id-string)))
+
+(defvar android-use-exec-loader) ; androidfns.c.
+
+(defun tramp-androidsu-maybe-open-connection (vec)
+ "Open a connection VEC if not already open.
+Mostly identical to `tramp-adb-maybe-open-connection', but also disables
+multibyte mode and waits for the shell prompt to appear."
+ ;; During completion, don't reopen a new connection.
+ (unless (tramp-connectable-p vec)
+ (throw 'non-essential 'non-essential))
+
+ (with-tramp-debug-message vec "Opening connection"
+ (let ((p (tramp-get-connection-process vec))
+ (process-name (tramp-get-connection-property vec "process-name"))
+ (process-environment (copy-sequence process-environment)))
+ ;; Open a new connection.
+ (condition-case err
+ (unless (process-live-p p)
+ (with-tramp-progress-reporter
+ vec 3
+ (if (tramp-string-empty-or-nil-p (tramp-file-name-user vec))
+ (format "Opening connection %s for %s using %s"
+ process-name
+ (tramp-file-name-host vec)
+ (tramp-file-name-method vec))
+ (format "Opening connection %s for %s@%s using %s"
+ process-name
+ (tramp-file-name-user vec)
+ (tramp-file-name-host vec)
+ (tramp-file-name-method vec)))
+ (let* ((coding-system-for-read 'utf-8-unix)
+ (process-connection-type tramp-process-connection-type)
+ ;; The executable loader cannot execute setuid
+ ;; binaries, such as su.
+ (android-use-exec-loader nil)
+ (p (start-process (tramp-get-connection-name vec)
+ (tramp-get-connection-buffer vec)
+ ;; Disregard
+ ;; `tramp-encoding-shell', as
+ ;; there's no guarantee that it's
+ ;; possible to execute it with
+ ;; `android-use-exec-loader' off.
+ tramp-androidsu-local-shell-name "-i"))
+ (user (tramp-file-name-user vec))
+ command)
+ ;; Set sentinel. Initialize variables.
+ (set-process-sentinel p #'tramp-process-sentinel)
+ (tramp-post-process-creation p vec)
+ ;; Replace `login-args' place holders.
+ (setq command (format "exec su - %s || exit" user))
+ ;; Attempt to execute the shell inside the global mount
+ ;; namespace if requested.
+ (when tramp-androidsu-mount-global-namespace
+ (progn
+ (when (eq tramp-androidsu-su-mm-supported 'unknown)
+ ;; Change the prompt in advance so that
+ ;; `tramp-adb-send-command-and-check' can call
+ ;; `tramp-search-regexp'.
+ (tramp-adb-send-command
+ vec (format "PS1=%s PS2=''"
+ (tramp-shell-quote-argument
+ tramp-end-of-output)))
+ (setq tramp-androidsu-su-mm-supported
+ ;; Detect support for `su -mm'.
+ (tramp-adb-send-command-and-check
+ vec "su -mm -c 'exit 24'" 24)))
+ (when tramp-androidsu-su-mm-supported
+ (tramp-set-connection-property
+ vec "remote-namespace" t)
+ (setq command (format "exec su -mm - %s || exit"
+ user)))))
+ ;; Send the command.
+ (tramp-message vec 3 "Sending command `%s'" command)
+ (tramp-adb-send-command vec command t t)
+ ;; Android su binaries contact a background service to
+ ;; obtain authentication; during this process, input
+ ;; received is discarded, so input cannot be
+ ;; guaranteed to reach the root shell until its prompt
+ ;; is displayed.
+ (with-current-buffer (process-buffer p)
+ (tramp-wait-for-regexp p tramp-connection-timeout
+ "#[[:space:]]*$"))
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)
+ ;; Change prompt.
+ (tramp-adb-send-command
+ vec (format "PS1=%s PS2=''"
+ (tramp-shell-quote-argument tramp-end-of-output)))
+ ;; Disable line editing.
+ (tramp-adb-send-command
+ vec "set +o vi +o vi-esccomplete +o vi-tabcomplete +o emacs")
+ ;; Disable Unicode, for otherwise Unicode filenames will
+ ;; not be decoded correctly.
+ (tramp-adb-send-command vec "set +U")
+ ;; Dump option settings in the traces.
+ (when (>= tramp-verbose 9)
+ (tramp-adb-send-command vec "set -o"))
+ ;; Disable echo expansion.
+ (tramp-adb-send-command
+ vec "stty -inlcr -onlcr -echo kill '^U' erase '^H'" t)
+ ;; Check whether the echo has really been disabled.
+ ;; Some implementations, like busybox, don't support
+ ;; disabling.
+ (tramp-adb-send-command vec "echo foo" t)
+ (with-current-buffer (process-buffer p)
+ (goto-char (point-min))
+ (when (looking-at-p "echo foo")
+ (tramp-set-connection-property p "remote-echo" t)
+ (tramp-message vec 5 "Remote echo still on. Ok.")
+ ;; Make sure backspaces and their echo are enabled
+ ;; and no line width magic interferes with them.
+ (tramp-adb-send-command
+ vec "stty icanon erase ^H cols 32767" t)))
+ ;; Mark it as connected.
+ (tramp-set-connection-property p "connected" t))))
+ ;; Cleanup, and propagate the signal.
+ ((error quit)
+ (tramp-cleanup-connection vec t)
+ (signal (car err) (cdr err)))))))
+
+(defun tramp-androidsu-generate-wrapper (function)
+ "Return connection wrapper function for FUNCTION.
+Return a function which temporarily substitutes local replacements for
+the `adb' method's connection management functions around a call to
+FUNCTION."
+ (lambda (&rest args)
+ (let ((tramp-adb-wait-for-output
+ (symbol-function #'tramp-adb-wait-for-output))
+ (tramp-adb-maybe-open-connection
+ (symbol-function #'tramp-adb-maybe-open-connection)))
+ (unwind-protect
+ (progn
+ ;; `tramp-adb-wait-for-output' addresses problems introduced
+ ;; by the adb utility itself, not Android utilities, so
+ ;; replace it with the regular Tramp function.
+ (fset 'tramp-adb-wait-for-output #'tramp-wait-for-output)
+ ;; Likewise, except some special treatment is necessary on
+ ;; account of flaws in Android's su implementation.
+ (fset 'tramp-adb-maybe-open-connection
+ #'tramp-androidsu-maybe-open-connection)
+ (apply function args))
+ ;; Restore the original definitions of the functions overridden
+ ;; above.
+ (fset 'tramp-adb-wait-for-output tramp-adb-wait-for-output)
+ (fset 'tramp-adb-maybe-open-connection
+ tramp-adb-maybe-open-connection)))))
+
+(defalias 'tramp-androidsu-handle-copy-file #'tramp-sh-handle-copy-file)
+
+(defalias 'tramp-androidsu-handle-delete-directory
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-directory))
+
+(defalias 'tramp-androidsu-handle-delete-file
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-delete-file))
+
+(defalias 'tramp-androidsu-handle-directory-files-and-attributes
+ (tramp-androidsu-generate-wrapper
+ #'tramp-adb-handle-directory-files-and-attributes))
+
+(defalias 'tramp-androidsu-handle-exec-path
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-exec-path))
+
+(defalias 'tramp-androidsu-handle-file-attributes
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-attributes))
+
+(defalias 'tramp-androidsu-handle-file-executable-p
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-executable-p))
+
+(defalias 'tramp-androidsu-handle-file-exists-p
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-exists-p))
+
+(defalias 'tramp-androidsu-handle-file-local-copy
+ #'tramp-sh-handle-file-local-copy)
+
+(defalias 'tramp-androidsu-handle-file-name-all-completions
+ (tramp-androidsu-generate-wrapper
+ #'tramp-adb-handle-file-name-all-completions))
+
+(defalias 'tramp-androidsu-handle-file-readable-p
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-readable-p))
+
+(defalias 'tramp-androidsu-handle-file-system-info
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-system-info))
+
+(defalias 'tramp-androidsu-handle-file-writable-p
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-file-writable-p))
+
+(defalias 'tramp-androidsu-handle-make-directory
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-make-directory))
+
+(defun tramp-androidsu-handle-make-process (&rest args)
+ "Like `tramp-handle-make-process', but modified for Android."
+ (when args
+ (with-parsed-tramp-file-name (expand-file-name default-directory) nil
+ (let ((default-directory tramp-compat-temporary-file-directory)
+ (name (plist-get args :name))
+ (buffer (plist-get args :buffer))
+ (command (plist-get args :command))
+ (coding (plist-get args :coding))
+ (noquery (plist-get args :noquery))
+ (connection-type
+ (or (plist-get args :connection-type) process-connection-type))
+ (filter (plist-get args :filter))
+ (sentinel (plist-get args :sentinel))
+ (stderr (plist-get args :stderr)))
+ (unless (stringp name)
+ (signal 'wrong-type-argument (list #'stringp name)))
+ (unless (or (bufferp buffer) (string-or-null-p buffer))
+ (signal 'wrong-type-argument (list #'bufferp buffer)))
+ (unless (consp command)
+ (signal 'wrong-type-argument (list #'consp command)))
+ (unless (or (null coding)
+ (and (symbolp coding) (memq coding coding-system-list))
+ (and (consp coding)
+ (memq (car coding) coding-system-list)
+ (memq (cdr coding) coding-system-list)))
+ (signal 'wrong-type-argument (list #'symbolp coding)))
+ (when (eq connection-type t)
+ (setq connection-type 'pty))
+ (unless (or (and (consp connection-type)
+ (memq (car connection-type) '(nil pipe pty))
+ (memq (cdr connection-type) '(nil pipe pty)))
+ (memq connection-type '(nil pipe pty)))
+ (signal 'wrong-type-argument (list #'symbolp connection-type)))
+ (unless (or (null filter) (eq filter t) (functionp filter))
+ (signal 'wrong-type-argument (list #'functionp filter)))
+ (unless (or (null sentinel) (functionp sentinel))
+ (signal 'wrong-type-argument (list #'functionp sentinel)))
+ (unless (or (null stderr) (bufferp stderr))
+ (signal 'wrong-type-argument (list #'bufferp stderr)))
+ (let* ((buffer
+ (if buffer
+ (get-buffer-create buffer)
+ ;; BUFFER can be nil. We use a temporary buffer.
+ (generate-new-buffer tramp-temp-buffer-name)))
+ (orig-command command)
+ (env (mapcar
+ (lambda (elt)
+ (when (tramp-compat-string-search "=" elt) elt))
+ tramp-remote-process-environment))
+ ;; We use as environment the difference to toplevel
+ ;; `process-environment'.
+ (env (dolist (elt process-environment env)
+ (when
+ (and
+ (tramp-compat-string-search "=" elt)
+ (not
+ (member
+ elt (default-toplevel-value 'process-environment))))
+ (setq env (cons elt env)))))
+ ;; Add remote path if exists.
+ (env (let ((remote-path
+ (string-join (tramp-get-remote-path v) ":")))
+ (setenv-internal env "PATH" remote-path 'keep)))
+ (env (setenv-internal
+ env "INSIDE_EMACS" (tramp-inside-emacs) 'keep))
+ (env (mapcar #'tramp-shell-quote-argument (delq nil env)))
+ ;; Quote command.
+ (command (mapconcat #'tramp-shell-quote-argument command " "))
+ ;; Set cwd and environment variables.
+ (command
+ (append
+ `("cd" ,(tramp-shell-quote-argument localname) "&&" "(" "env")
+ env `(,command ")")))
+ ;; Add remote shell if needed.
+ (command
+ (if (consp (tramp-get-method-parameter v 'tramp-direct-async))
+ (append
+ (tramp-get-method-parameter v 'tramp-direct-async)
+ `(,(string-join command " ")))
+ command))
+ p)
+ ;; Generate a command to start the process using `su' with
+ ;; suitable options for specifying the mount namespace and
+ ;; suchlike.
+ (setq
+ p (make-process
+ :name name :buffer buffer
+ :command (if (tramp-get-connection-property v "remote-namespace")
+ (append (list "su" "-mm" "-" user "-c") command)
+ (append (list "su" "-" user "-c") command))
+ :coding coding :noquery noquery :connection-type connection-type
+ :sentinel sentinel :stderr stderr))
+ ;; Set filter. Prior Emacs 29.1, it doesn't work reliably
+ ;; to provide it as `make-process' argument when filter is
+ ;; t. See Bug#51177.
+ (when filter
+ (set-process-filter p filter))
+ (tramp-post-process-creation p v)
+ ;; Query flag is overwritten in `tramp-post-process-creation',
+ ;; so we reset it.
+ (set-process-query-on-exit-flag p (null noquery))
+ ;; This is needed for ssh or PuTTY based processes, and
+ ;; only if the respective options are set. Perhaps, the
+ ;; setting could be more fine-grained.
+ ;; (process-put p 'tramp-shared-socket t)
+ (process-put p 'remote-command orig-command)
+ (tramp-set-connection-property p "remote-command" orig-command)
+ (when (bufferp stderr)
+ (tramp-taint-remote-process-buffer stderr))
+ p)))))
+
+(defalias 'tramp-androidsu-handle-make-symbolic-link
+ #'tramp-sh-handle-make-symbolic-link)
+
+(defalias 'tramp-androidsu-handle-process-file
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-process-file))
+
+(defalias 'tramp-androidsu-handle-rename-file #'tramp-sh-handle-rename-file)
+
+(defalias 'tramp-androidsu-handle-set-file-modes
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-set-file-modes))
+
+(defalias 'tramp-androidsu-handle-set-file-times
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-set-file-times))
+
+(defalias 'tramp-androidsu-handle-get-remote-gid
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-gid))
+
+(defalias 'tramp-androidsu-handle-get-remote-groups
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-groups))
+
+(defalias 'tramp-androidsu-handle-get-remote-uid
+ (tramp-androidsu-generate-wrapper #'tramp-adb-handle-get-remote-uid))
+
+(defalias 'tramp-androidsu-handle-write-region #'tramp-sh-handle-write-region)
+
+;;;###tramp-autoload
+(defconst tramp-androidsu-file-name-handler-alist
+ '(;; `abbreviate-file-name' performed by default handler.
+ (access-file . tramp-handle-access-file)
+ (add-name-to-file . tramp-handle-add-name-to-file)
+ ;; `byte-compiler-base-file-name' performed by default handler.
+ (copy-directory . tramp-handle-copy-directory)
+ (copy-file . tramp-androidsu-handle-copy-file)
+ (delete-directory . tramp-androidsu-handle-delete-directory)
+ (delete-file . tramp-androidsu-handle-delete-file)
+ ;; `diff-latest-backup-file' performed by default handler.
+ (directory-file-name . tramp-handle-directory-file-name)
+ (directory-files . tramp-handle-directory-files)
+ (directory-files-and-attributes
+ . tramp-androidsu-handle-directory-files-and-attributes)
+ (dired-compress-file . ignore)
+ (dired-uncache . tramp-handle-dired-uncache)
+ (exec-path . tramp-androidsu-handle-exec-path)
+ (expand-file-name . tramp-handle-expand-file-name)
+ (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
+ (file-acl . ignore)
+ (file-attributes . tramp-androidsu-handle-file-attributes)
+ (file-directory-p . tramp-handle-file-directory-p)
+ (file-equal-p . tramp-handle-file-equal-p)
+ (file-executable-p . tramp-androidsu-handle-file-executable-p)
+ (file-exists-p . tramp-androidsu-handle-file-exists-p)
+ (file-group-gid . tramp-handle-file-group-gid)
+ (file-in-directory-p . tramp-handle-file-in-directory-p)
+ (file-local-copy . tramp-androidsu-handle-file-local-copy)
+ (file-locked-p . tramp-handle-file-locked-p)
+ (file-modes . tramp-handle-file-modes)
+ (file-name-all-completions
+ . tramp-androidsu-handle-file-name-all-completions)
+ (file-name-as-directory . tramp-handle-file-name-as-directory)
+ (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
+ (file-name-completion . tramp-handle-file-name-completion)
+ (file-name-directory . tramp-handle-file-name-directory)
+ (file-name-nondirectory . tramp-handle-file-name-nondirectory)
+ ;; `file-name-sans-versions' performed by default handler.
+ (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
+ (file-notify-add-watch . tramp-handle-file-notify-add-watch)
+ (file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
+ (file-notify-valid-p . tramp-handle-file-notify-valid-p)
+ (file-ownership-preserved-p . ignore)
+ (file-readable-p . tramp-androidsu-handle-file-readable-p)
+ (file-regular-p . tramp-handle-file-regular-p)
+ (file-remote-p . tramp-handle-file-remote-p)
+ (file-selinux-context . tramp-handle-file-selinux-context)
+ (file-symlink-p . tramp-handle-file-symlink-p)
+ (file-system-info . tramp-androidsu-handle-file-system-info)
+ (file-truename . tramp-handle-file-truename)
+ (file-user-uid . tramp-handle-file-user-uid)
+ (file-writable-p . tramp-androidsu-handle-file-writable-p)
+ (find-backup-file-name . tramp-handle-find-backup-file-name)
+ ;; `get-file-buffer' performed by default handler.
+ (insert-directory . tramp-handle-insert-directory)
+ (insert-file-contents . tramp-handle-insert-file-contents)
+ (list-system-processes . tramp-handle-list-system-processes)
+ (load . tramp-handle-load)
+ (lock-file . tramp-handle-lock-file)
+ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
+ (make-directory . tramp-androidsu-handle-make-directory)
+ (make-directory-internal . ignore)
+ (make-lock-file-name . tramp-handle-make-lock-file-name)
+ (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
+ (make-process . tramp-androidsu-handle-make-process)
+ (make-symbolic-link . tramp-androidsu-handle-make-symbolic-link)
+ (memory-info . tramp-handle-memory-info)
+ (process-attributes . tramp-handle-process-attributes)
+ (process-file . tramp-androidsu-handle-process-file)
+ (rename-file . tramp-androidsu-handle-rename-file)
+ (set-file-acl . ignore)
+ (set-file-modes . tramp-androidsu-handle-set-file-modes)
+ (set-file-selinux-context . ignore)
+ (set-file-times . tramp-androidsu-handle-set-file-times)
+ (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
+ (shell-command . tramp-handle-shell-command)
+ (start-file-process . tramp-handle-start-file-process)
+ (substitute-in-file-name . tramp-handle-substitute-in-file-name)
+ (temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-home-directory . ignore)
+ (tramp-get-remote-gid . tramp-androidsu-handle-get-remote-gid)
+ (tramp-get-remote-groups . tramp-androidsu-handle-get-remote-groups)
+ (tramp-get-remote-uid . tramp-androidsu-handle-get-remote-uid)
+ (tramp-set-file-uid-gid . ignore)
+ (unhandled-file-name-directory . ignore)
+ (unlock-file . tramp-handle-unlock-file)
+ (vc-registered . ignore)
+ (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
+ (write-region . tramp-androidsu-handle-write-region))
+ "Alist of Tramp handler functions for superuser sessions on Android.")
+
+;; It must be a `defsubst' in order to push the whole code into
+;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
+;;;###tramp-autoload
+(defsubst tramp-androidsu-file-name-p (vec-or-filename)
+ "Check whether VEC-OR-FILENAME is for the `androidsu' method."
+ (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
+ (equal (tramp-file-name-method vec) tramp-androidsu-method)))
+
+;;;###tramp-autoload
+(defun tramp-androidsu-file-name-handler (operation &rest args)
+ "Invoke the `androidsu' handler for OPERATION.
+First arg specifies the OPERATION, second arg is a list of
+arguments to pass to the OPERATION."
+ (if-let ((fn (assoc operation tramp-androidsu-file-name-handler-alist)))
+ (prog1 (save-match-data (apply (cdr fn) args))
+ (setq tramp-debug-message-fnh-function (cdr fn)))
+ (prog1 (tramp-run-real-handler operation args)
+ (setq tramp-debug-message-fnh-function operation))))
+
+;;;###tramp-autoload
+(tramp--with-startup
+ (tramp-register-foreign-file-name-handler
+ #'tramp-androidsu-file-name-p #'tramp-androidsu-file-name-handler))
+
+;;; Default connection-local variables for Tramp.
+
+(defconst tramp-androidsu-connection-local-default-variables
+ `((tramp-remote-path . ,tramp-androidsu-remote-path))
+ "Default connection-local variables for remote androidsu connections.")
+
+(connection-local-set-profile-variables
+ 'tramp-androidsu-connection-local-default-profile
+ tramp-androidsu-connection-local-default-variables)
+
+(connection-local-set-profiles
+ `(:application tramp :protocol ,tramp-androidsu-method)
+ 'tramp-androidsu-connection-local-default-profile)
+
+(with-eval-after-load 'shell
+ (connection-local-set-profiles
+ `(:application tramp :protocol ,tramp-androidsu-method)
+ 'tramp-adb-connection-local-default-shell-profile
+ 'tramp-adb-connection-local-default-ps-profile))
+
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-androidsu 'force)))
+
+(provide 'tramp-androidsu)
+;;; tramp-androidsu.el ends here
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index 298cacdb0e0..59c4223794c 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -387,6 +387,8 @@ arguments to pass to the OPERATION."
;;;###autoload
(progn (defun tramp-register-archive-autoload-file-name-handler ()
"Add archive file name handler to `file-name-handler-alist'."
+ ;; Do not use read syntax #' for `tramp-archive-file-name-handler', it
+ ;; isn't autoloaded.
(when (and tramp-archive-enabled
(not
(rassq 'tramp-archive-file-name-handler file-name-handler-alist)))
@@ -443,7 +445,7 @@ arguments to pass to the OPERATION."
(and (tramp-archive-file-name-p name)
(match-string 2 name)))
-(defvar tramp-archive-hash (make-hash-table :test 'equal)
+(defvar tramp-archive-hash (make-hash-table :test #'equal)
"Hash table for archive local copies.
The hash key is the archive name. The value is a cons of the
used `tramp-file-name' structure for tramp-gvfs, and the file
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 25123a6e282..225a26ad1cd 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -144,7 +144,6 @@ If KEY is `tramp-cache-undefined', don't create anything, and return nil."
(defun tramp-get-file-property (key file property &optional default)
"Get the PROPERTY of FILE from the cache context of KEY.
Return DEFAULT if not set."
- ;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq key (tramp-file-name-unify key file))
(if (eq key tramp-cache-undefined) default
(let* ((hash (tramp-get-hash-table key))
@@ -191,7 +190,6 @@ Return DEFAULT if not set."
(defun tramp-set-file-property (key file property value)
"Set the PROPERTY of FILE to VALUE, in the cache context of KEY.
Return VALUE."
- ;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq key (tramp-file-name-unify key file))
(if (eq key tramp-cache-undefined) value
(let ((hash (tramp-get-hash-table key)))
@@ -224,7 +222,6 @@ Return VALUE."
;;;###tramp-autoload
(defun tramp-flush-file-property (key file property)
"Remove PROPERTY of FILE in the cache context of KEY."
- ;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq key (tramp-file-name-unify key file))
(unless (eq key tramp-cache-undefined)
(remhash property (tramp-get-hash-table key))
@@ -239,7 +236,6 @@ Return VALUE."
;; `file-name-directory' can return nil, for example for "~".
(when-let ((file (file-name-directory file))
(file (directory-file-name file)))
- ;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq key (tramp-file-name-unify key file))
(unless (eq key tramp-cache-undefined)
(dolist (property (hash-table-keys (tramp-get-hash-table key)))
@@ -254,7 +250,6 @@ Return VALUE."
(defun tramp-flush-file-properties (key file)
"Remove all properties of FILE in the cache context of KEY."
(let ((truename (tramp-get-file-property key file "file-truename")))
- ;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq key (tramp-file-name-unify key file))
(unless (eq key tramp-cache-undefined)
(tramp-message key 8 "%s" (tramp-file-name-localname key))
@@ -338,17 +333,15 @@ FILE must be a local file name on a connection identified via KEY."
"Save PROPERTY, run BODY, reset PROPERTY.
Preserve timestamps."
(declare (indent 3) (debug t))
- `(progn
- ;; Unify localname. Remove hop from `tramp-file-name' structure.
- (setf ,key (tramp-file-name-unify ,key ,file))
- (let* ((hash (tramp-get-hash-table ,key))
- (cached (and (hash-table-p hash) (gethash ,property hash))))
- (unwind-protect (progn ,@body)
- ;; Reset PROPERTY. Recompute hash, it could have been flushed.
- (setq hash (tramp-get-hash-table ,key))
- (if (consp cached)
- (puthash ,property cached hash)
- (remhash ,property hash))))))
+ `(let* ((key (tramp-file-name-unify ,key ,file))
+ (hash (tramp-get-hash-table key))
+ (cached (and (hash-table-p hash) (gethash ,property hash))))
+ (unwind-protect (progn ,@body)
+ ;; Reset PROPERTY. Recompute hash, it could have been flushed.
+ (setq hash (tramp-get-hash-table key))
+ (if (consp cached)
+ (puthash ,property cached hash)
+ (remhash ,property hash)))))
;;;###tramp-autoload
(defmacro with-tramp-saved-file-properties (key file properties &rest body)
@@ -356,22 +349,20 @@ Preserve timestamps."
PROPERTIES is a list of file properties (strings).
Preserve timestamps."
(declare (indent 3) (debug t))
- `(progn
- ;; Unify localname. Remove hop from `tramp-file-name' structure.
- (setf ,key (tramp-file-name-unify ,key ,file))
- (let* ((hash (tramp-get-hash-table ,key))
- (values
- (and (hash-table-p hash)
- (mapcar
- (lambda (property) (cons property (gethash property hash)))
- ,properties))))
- (unwind-protect (progn ,@body)
- ;; Reset PROPERTIES. Recompute hash, it could have been flushed.
- (setq hash (tramp-get-hash-table ,key))
- (dolist (value values)
- (if (consp (cdr value))
- (puthash (car value) (cdr value) hash)
- (remhash (car value) hash)))))))
+ `(let* ((key (tramp-file-name-unify ,key ,file))
+ (hash (tramp-get-hash-table key))
+ (values
+ (and (hash-table-p hash)
+ (mapcar
+ (lambda (property) (cons property (gethash property hash)))
+ ,properties))))
+ (unwind-protect (progn ,@body)
+ ;; Reset PROPERTIES. Recompute hash, it could have been flushed.
+ (setq hash (tramp-get-hash-table key))
+ (dolist (value values)
+ (if (consp (cdr value))
+ (puthash (car value) (cdr value) hash)
+ (remhash (car value) hash))))))
;;; -- Properties --
@@ -473,38 +464,36 @@ used to cache connection properties of the local machine."
(defmacro with-tramp-saved-connection-property (key property &rest body)
"Save PROPERTY, run BODY, reset PROPERTY."
(declare (indent 2) (debug t))
- `(progn
- (setf ,key (tramp-file-name-unify ,key))
- (let* ((hash (tramp-get-hash-table ,key))
- (cached (and (hash-table-p hash)
- (gethash ,property hash tramp-cache-undefined))))
- (unwind-protect (progn ,@body)
- ;; Reset PROPERTY. Recompute hash, it could have been flushed.
- (setq hash (tramp-get-hash-table ,key))
- (if (not (eq cached tramp-cache-undefined))
- (puthash ,property cached hash)
- (remhash ,property hash))))))
+ `(let* ((key (tramp-file-name-unify ,key))
+ (hash (tramp-get-hash-table key))
+ (cached (and (hash-table-p hash)
+ (gethash ,property hash tramp-cache-undefined))))
+ (unwind-protect (progn ,@body)
+ ;; Reset PROPERTY. Recompute hash, it could have been flushed.
+ (setq hash (tramp-get-hash-table key))
+ (if (not (eq cached tramp-cache-undefined))
+ (puthash ,property cached hash)
+ (remhash ,property hash)))))
;;;###tramp-autoload
(defmacro with-tramp-saved-connection-properties (key properties &rest body)
"Save PROPERTIES, run BODY, reset PROPERTIES.
PROPERTIES is a list of file properties (strings)."
(declare (indent 2) (debug t))
- `(progn
- (setf ,key (tramp-file-name-unify ,key))
- (let* ((hash (tramp-get-hash-table ,key))
- (values
- (mapcar
- (lambda (property)
- (cons property (gethash property hash tramp-cache-undefined)))
- ,properties)))
- (unwind-protect (progn ,@body)
- ;; Reset PROPERTIES. Recompute hash, it could have been flushed.
- (setq hash (tramp-get-hash-table ,key))
- (dolist (value values)
- (if (not (eq (cdr value) tramp-cache-undefined))
- (puthash (car value) (cdr value) hash)
- (remhash (car value) hash)))))))
+ `(let* ((key (tramp-file-name-unify ,key))
+ (hash (tramp-get-hash-table key))
+ (values
+ (mapcar
+ (lambda (property)
+ (cons property (gethash property hash tramp-cache-undefined)))
+ ,properties)))
+ (unwind-protect (progn ,@body)
+ ;; Reset PROPERTIES. Recompute hash, it could have been flushed.
+ (setq hash (tramp-get-hash-table key))
+ (dolist (value values)
+ (if (not (eq (cdr value) tramp-cache-undefined))
+ (puthash (car value) (cdr value) hash)
+ (remhash (car value) hash))))))
;;;###tramp-autoload
(defun tramp-cache-print (table)
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index a545a8e7273..d3af7a009ec 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -281,7 +281,7 @@ non-nil."
;; Remove all buffers with a remote default-directory which fit the hook.
(dolist (name (tramp-list-remote-buffers))
(and (buffer-live-p (get-buffer name))
- (with-current-buffer (get-buffer name)
+ (with-current-buffer name
(run-hook-with-args-until-success 'tramp-cleanup-some-buffers-hook))
(kill-buffer name))))
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 8065ba01734..98de0dba7ff 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -309,7 +309,7 @@ Also see `ignore'."
;; Macro `connection-local-p' is new in Emacs 30.1.
(if (macrop 'connection-local-p)
- (defalias 'tramp-compat-connection-local-p #'connection-local-p)
+ (defalias 'tramp-compat-connection-local-p 'connection-local-p)
(defmacro tramp-compat-connection-local-p (variable)
"Non-nil if VARIABLE has a connection-local binding in `default-directory'."
`(let (connection-local-variables-alist file-local-variables-alist)
@@ -330,6 +330,18 @@ Also see `ignore'."
;;; TODO:
;;
;; * Starting with Emacs 27.1, there's no need to escape open
-;; parentheses with a backslash in docstrings anymore.
+;; parentheses with a backslash in docstrings anymore. However,
+;; `outline-minor-mode' has still problems with this. Since there
+;; are developers using `outline-minor-mode' in Lisp files, we still
+;; keep this quoting.
+;;
+;; * Starting with Emacs 29.1, use `buffer-match-p'.
+;;
+;; * Starting with Emacs 29.1, use `string-split'.
+;;
+;; * Starting with Emacs 30.1, there is `handler-bind'. Use it
+;; instead of `condition-case' when the origin of an error shall be
+;; kept, for example when the HANDLER propagates the error with
+;; `(signal (car err) (cdr err)'.
;;; tramp-compat.el ends here
diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el
index 1f578949e4d..30639cbeb85 100644
--- a/lisp/net/tramp-container.el
+++ b/lisp/net/tramp-container.el
@@ -31,15 +31,20 @@
;; Open a file on a running Docker container:
;;
;; C-x C-f /docker:USER@CONTAINER:/path/to/file
+;; C-x C-f /dockercp:USER@CONTAINER:/path/to/file
;;
;; or Podman:
;;
;; C-x C-f /podman:USER@CONTAINER:/path/to/file
+;; C-x C-f /podmancp:USER@CONTAINER:/path/to/file
;;
;; Where:
;; USER is the user on the container to connect as (optional).
;; CONTAINER is the container to connect to.
;;
+;; "docker" and "podman" are inline methods, "dockercp" and "podmancp"
+;; are out-of-band methods.
+;;
;;
;;
;; Open file in a Kubernetes container:
@@ -142,10 +147,20 @@ If it is nil, the default context will be used."
"Tramp method name to use to connect to Docker containers.")
;;;###tramp-autoload
+(defconst tramp-dockercp-method "dockercp"
+ "Tramp method name to use to connect to Docker containers.
+This is for out-of-band connections.")
+
+;;;###tramp-autoload
(defconst tramp-podman-method "podman"
"Tramp method name to use to connect to Podman containers.")
;;;###tramp-autoload
+(defconst tramp-podmancp-method "podmancp"
+ "Tramp method name to use to connect to Podman containers.
+This is for out-of-band connections.")
+
+;;;###tramp-autoload
(defconst tramp-kubernetes-method "kubernetes"
"Tramp method name to use to connect to Kubernetes containers.")
@@ -183,7 +198,8 @@ BODY is the backend specific code."
(defun tramp-container--completion-function (method)
"List running containers available for connection.
METHOD is the Tramp method to be used for \"ps\", either
-`tramp-docker-method' or `tramp-podman-method'.
+`tramp-docker-method', `tramp-dockercp-method', `tramp-podman-method',
+or `tramp-podmancp-method'.
This function is used by `tramp-set-completion-function', please
see its function help for a description of the format."
@@ -376,6 +392,23 @@ see its function help for a description of the format."
(tramp-remote-shell-args ("-i" "-c"))))
(add-to-list 'tramp-methods
+ `(,tramp-dockercp-method
+ (tramp-login-program ,tramp-docker-program)
+ (tramp-login-args (("exec")
+ ("-it")
+ ("-u" "%u")
+ ("%h")
+ ("%l")))
+ (tramp-direct-async (,tramp-default-remote-shell "-c"))
+ (tramp-remote-shell ,tramp-default-remote-shell)
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-i" "-c"))
+ (tramp-copy-program ,tramp-docker-program)
+ (tramp-copy-args (("cp")))
+ (tramp-copy-file-name (("%h" ":") ("%f")))
+ (tramp-copy-recursive t)))
+
+ (add-to-list 'tramp-methods
`(,tramp-podman-method
(tramp-login-program ,tramp-podman-program)
(tramp-login-args (("exec")
@@ -389,6 +422,23 @@ see its function help for a description of the format."
(tramp-remote-shell-args ("-i" "-c"))))
(add-to-list 'tramp-methods
+ `(,tramp-podmancp-method
+ (tramp-login-program ,tramp-podman-program)
+ (tramp-login-args (("exec")
+ ("-it")
+ ("-u" "%u")
+ ("%h")
+ ("%l")))
+ (tramp-direct-async (,tramp-default-remote-shell "-c"))
+ (tramp-remote-shell ,tramp-default-remote-shell)
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-i" "-c"))
+ (tramp-copy-program ,tramp-podman-program)
+ (tramp-copy-args (("cp")))
+ (tramp-copy-file-name (("%h" ":") ("%f")))
+ (tramp-copy-recursive t)))
+
+ (add-to-list 'tramp-methods
`(,tramp-kubernetes-method
(tramp-login-program ,tramp-kubernetes-program)
(tramp-login-args (("%x") ; context and namespace.
@@ -432,10 +482,18 @@ see its function help for a description of the format."
`((tramp-container--completion-function ,tramp-docker-method)))
(tramp-set-completion-function
+ tramp-dockercp-method
+ `((tramp-container--completion-function ,tramp-dockercp-method)))
+
+ (tramp-set-completion-function
tramp-podman-method
`((tramp-container--completion-function ,tramp-podman-method)))
(tramp-set-completion-function
+ tramp-podmancp-method
+ `((tramp-container--completion-function ,tramp-podmancp-method)))
+
+ (tramp-set-completion-function
tramp-kubernetes-method
`((tramp-kubernetes--completion-function ,tramp-kubernetes-method)))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 72589e7ce4a..93071ed7350 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -888,7 +888,8 @@ Operations not mentioned here will be handled by the default Emacs primitives.")
"Invoke the GVFS related OPERATION and ARGS.
First arg specifies the OPERATION, second arg is a list of
arguments to pass to the OPERATION."
- (unless tramp-gvfs-enabled
+ ;; `file-remote-p' must not return an error. (Bug#68976)
+ (unless (or tramp-gvfs-enabled (eq operation 'file-remote-p))
(tramp-user-error nil "Package `tramp-gvfs' not supported"))
(if-let ((filename (apply #'tramp-file-name-for-operation operation args))
(tramp-gvfs-dbus-event-vector
@@ -2293,8 +2294,8 @@ connection if a previous connection has died for some reason."
;; indicated by the "mounted" signal, i.e. the
;; "fuse-mountpoint" file property.
(with-timeout
- ((or (tramp-get-method-parameter vec 'tramp-connection-timeout)
- tramp-connection-timeout)
+ ((tramp-get-method-parameter
+ vec 'tramp-connection-timeout tramp-connection-timeout)
(if (tramp-string-empty-or-nil-p (tramp-file-name-user vec))
(tramp-error
vec 'file-error
diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el
index c0b60f57e40..e1f0b2a3495 100644
--- a/lisp/net/tramp-integration.el
+++ b/lisp/net/tramp-integration.el
@@ -69,7 +69,7 @@ special handling of `substitute-in-file-name'."
(when minibuffer-completing-file-name
(setq tramp-rfn-eshadow-overlay
(make-overlay (minibuffer-prompt-end) (minibuffer-prompt-end)))
- ;; Copy rfn-eshadow-overlay properties.
+ ;; Copy `rfn-eshadow-overlay' properties.
(let ((props (overlay-properties rfn-eshadow-overlay)))
(while props
;; The `field' property prevents correct minibuffer
diff --git a/lisp/net/tramp-message.el b/lisp/net/tramp-message.el
index 96071e626a5..97e94a51e7a 100644
--- a/lisp/net/tramp-message.el
+++ b/lisp/net/tramp-message.el
@@ -353,6 +353,7 @@ applicable)."
If VEC-OR-PROC is nil, the buffer *debug tramp* is used. FORCE
forces the backtrace even if `tramp-verbose' is less than 10.
This function is meant for debugging purposes."
+ (declare (tramp-suppress-trace t))
(let ((tramp-verbose (if force 10 tramp-verbose)))
(when (>= tramp-verbose 10)
(tramp-message
@@ -364,6 +365,7 @@ VEC-OR-PROC identifies the connection to use, SIGNAL is the
signal identifier to be raised, remaining arguments passed to
`tramp-message'. Finally, signal SIGNAL is raised with
FMT-STRING and ARGUMENTS."
+ (declare (tramp-suppress-trace t))
(let (signal-hook-function)
(tramp-backtrace vec-or-proc)
(unless arguments
@@ -391,6 +393,7 @@ tramp-tests.el.")
"Emit an error, and show BUF.
If BUF is nil, show the connection buf. Wait for 30\", or until
an input event arrives. The other arguments are passed to `tramp-error'."
+ (declare (tramp-suppress-trace t))
(save-window-excursion
(let* ((buf (or (and (bufferp buf) buf)
(and (processp vec-or-proc) (process-buffer vec-or-proc))
@@ -424,6 +427,7 @@ an input event arrives. The other arguments are passed to `tramp-error'."
(defsubst tramp-user-error (vec-or-proc fmt-string &rest arguments)
"Signal a user error (or \"pilot error\")."
+ (declare (tramp-suppress-trace t))
(unwind-protect
(apply #'tramp-error vec-or-proc 'user-error fmt-string arguments)
;; Save exit.
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 6489f473634..66e648624b2 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -38,7 +38,6 @@
(declare-function dired-compress-file "dired-aux")
(declare-function dired-remove-file "dired-aux")
(defvar dired-compress-file-suffixes)
-(defvar ls-lisp-use-insert-directory-program)
;; Added in Emacs 28.1.
(defvar process-file-return-signal-string)
(defvar vc-handled-backends)
@@ -283,6 +282,7 @@ The string is used in `tramp-methods'.")
(tramp-copy-program "nc")
;; We use "-v" for better error tracking.
(tramp-copy-args (("-w" "1") ("-v") ("%h") ("%r")))
+ (tramp-copy-file-name (("%f")))
(tramp-remote-copy-program "nc")
;; We use "-p" as required for newer busyboxes. For older
;; busybox/nc versions, the value must be (("-l") ("%r")). This
@@ -429,6 +429,9 @@ The string is used in `tramp-methods'.")
eos)
nil ,(user-login-name))))
+(defconst tramp-default-copy-file-name '(("%u" "@") ("%h" ":") ("%f"))
+ "Default `tramp-copy-file-name' entry for out-of-band methods.")
+
;;;###tramp-autoload
(defconst tramp-completion-function-alist-rsh
'((tramp-parse-rhosts "/etc/hosts.equiv")
@@ -548,6 +551,7 @@ shell from reading its init file."
(tramp-terminal-prompt-regexp tramp-action-terminal)
(tramp-antispoof-regexp tramp-action-confirm-message)
(tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message)
+ (tramp-security-key-pin-regexp tramp-action-otp-password)
(tramp-process-alive-regexp tramp-action-process-alive))
"List of pattern/action pairs.
Whenever a pattern matches, the corresponding action is performed.
@@ -567,6 +571,7 @@ corresponding PATTERN matches, the ACTION function is called.")
(tramp-wrong-passwd-regexp tramp-action-permission-denied)
(tramp-copy-failed-regexp tramp-action-permission-denied)
(tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message)
+ (tramp-security-key-pin-regexp tramp-action-otp-password)
(tramp-process-alive-regexp tramp-action-out-of-band))
"List of pattern/action pairs.
This list is used for copying/renaming with out-of-band methods.
@@ -2010,7 +2015,7 @@ ID-FORMAT valid values are `string' and `integer'."
#'copy-directory
(list dirname newname keep-date parents copy-contents))))
- ;; When newname did exist, we have wrong cached values.
+ ;; NEWNAME has wrong cached values.
(when t2
(with-parsed-tramp-file-name (expand-file-name newname) nil
(tramp-flush-file-properties v localname)))))))
@@ -2149,24 +2154,24 @@ file names."
;; One of them must be a Tramp file.
(error "Tramp implementation says this cannot happen")))
- ;; Handle `preserve-extended-attributes'. We ignore
- ;; possible errors, because ACL strings could be
- ;; incompatible.
- (when-let ((attributes (and preserve-extended-attributes
- (file-extended-attributes filename))))
- (ignore-errors
- (set-file-extended-attributes newname attributes)))
-
;; In case of `rename', we must flush the cache of the source file.
(when (and t1 (eq op 'rename))
(with-parsed-tramp-file-name filename v1
(tramp-flush-file-properties v1 v1-localname)))
- ;; When newname did exist, we have wrong cached values.
+ ;; NEWNAME has wrong cached values.
(when t2
(with-parsed-tramp-file-name newname v2
(tramp-flush-file-properties v2 v2-localname)))
+ ;; Handle `preserve-extended-attributes'. We ignore
+ ;; possible errors, because ACL strings could be
+ ;; incompatible.
+ (when-let ((attributes (and preserve-extended-attributes
+ (file-extended-attributes filename))))
+ (ignore-errors
+ (set-file-extended-attributes newname attributes)))
+
;; KEEP-DATE handling.
(when (and keep-date (not copy-keep-date))
(tramp-compat-set-file-times
@@ -2398,10 +2403,10 @@ The method used must be an out-of-band method."
#'file-name-as-directory
#'identity)
(if v1
- (tramp-make-copy-program-file-name v1)
+ (tramp-make-copy-file-name v1)
(file-name-unquote filename)))
target (if v2
- (tramp-make-copy-program-file-name v2)
+ (tramp-make-copy-file-name v2)
(file-name-unquote newname)))
;; Check for listener port.
@@ -2438,9 +2443,9 @@ The method used must be an out-of-band method."
copy-program (tramp-get-method-parameter v 'tramp-copy-program)
copy-args
;; " " has either been a replacement of "%k" (when
- ;; keep-date argument is non-nil), or a replacement for
+ ;; KEEP-DATE argument is non-nil), or a replacement for
;; the whole keep-date sublist.
- (delete " " (apply #'tramp-expand-args v 'tramp-copy-args spec))
+ (delete " " (apply #'tramp-expand-args v 'tramp-copy-args nil spec))
;; `tramp-ssh-controlmaster-options' is a string instead
;; of a list. Unflatten it.
copy-args
@@ -2449,11 +2454,11 @@ The method used must be an out-of-band method."
(lambda (x) (if (tramp-compat-string-search " " x)
(split-string x) x))
copy-args))
- copy-env (apply #'tramp-expand-args v 'tramp-copy-env spec)
+ copy-env (apply #'tramp-expand-args v 'tramp-copy-env nil spec)
remote-copy-program
(tramp-get-method-parameter v 'tramp-remote-copy-program)
remote-copy-args
- (apply #'tramp-expand-args v 'tramp-remote-copy-args spec))
+ (apply #'tramp-expand-args v 'tramp-remote-copy-args nil spec))
;; Check for local copy program.
(unless (executable-find copy-program)
@@ -2636,7 +2641,7 @@ The method used must be an out-of-band method."
(defun tramp-sh-handle-insert-directory
(filename switches &optional wildcard full-directory-p)
"Like `insert-directory' for Tramp files."
- (if (and (featurep 'ls-lisp)
+ (if (and (boundp 'ls-lisp-use-insert-directory-program)
(not ls-lisp-use-insert-directory-program))
(tramp-handle-insert-directory
filename switches wildcard full-directory-p)
@@ -3652,20 +3657,20 @@ filled are described in `tramp-bundle-read-file-names'."
(dolist
(elt
- (ignore-errors
+ (with-current-buffer (tramp-get-connection-buffer vec)
;; We cannot use `tramp-send-command-and-read', because
;; this does not cooperate well with heredoc documents.
- (tramp-send-command
- vec
- (format
- "tramp_bundle_read_file_names <<'%s'\n%s\n%s\n"
- tramp-end-of-heredoc
- (mapconcat #'tramp-shell-quote-argument files "\n")
- tramp-end-of-heredoc))
- (with-current-buffer (tramp-get-connection-buffer vec)
- ;; Read the expression.
- (goto-char (point-min))
- (read (current-buffer)))))
+ (unless (tramp-send-command-and-check
+ vec
+ (format
+ "tramp_bundle_read_file_names <<'%s'\n%s\n%s\n"
+ tramp-end-of-heredoc
+ (mapconcat #'tramp-shell-quote-argument files "\n")
+ tramp-end-of-heredoc))
+ (tramp-error vec 'file-error "%s" (tramp-get-buffer-string)))
+ ;; Read the expression.
+ (goto-char (point-min))
+ (read (current-buffer))))
(tramp-set-file-property vec (car elt) "file-exists-p" (nth 1 elt))
(tramp-set-file-property vec (car elt) "file-readable-p" (nth 2 elt))
@@ -4112,7 +4117,7 @@ Only send the definition if it has not already been done."
(unless (member name scripts)
(with-tramp-progress-reporter
vec 5 (format-message "Sending script `%s'" name)
- ;; In bash, leading TABs like in `tramp-vc-registered-read-file-names'
+ ;; In bash, leading TABs like in `tramp-bundle-read-file-names'
;; could result in unwanted command expansion. Avoid this.
(setq script (tramp-compat-string-replace
(make-string 1 ?\t) (make-string 8 ? ) script))
@@ -5289,7 +5294,8 @@ connection if a previous connection has died for some reason."
(tramp-get-method-parameter hop 'tramp-async-args)))
(connection-timeout
(tramp-get-method-parameter
- hop 'tramp-connection-timeout))
+ hop 'tramp-connection-timeout
+ tramp-connection-timeout))
(command
(tramp-get-method-parameter
hop 'tramp-login-program))
@@ -5347,14 +5353,14 @@ connection if a previous connection has died for some reason."
;; Add arguments for asynchronous processes.
(when process-name async-args)
(tramp-expand-args
- hop 'tramp-login-args
+ hop 'tramp-login-args nil
?h (or l-host "") ?u (or l-user "") ?p (or l-port "")
?c (format-spec options (format-spec-make ?t tmpfile))
?n (concat
"2>" (tramp-get-remote-null-device previous-hop))
?l (concat remote-shell " " extra-args " -i"))
;; A restricted shell does not allow "exec".
- (when r-shell '("&&" "exit" "||" "exit")))
+ (when r-shell '("&&" "exit")) '("||" "exit"))
" "))
;; Send the command.
@@ -5364,8 +5370,7 @@ connection if a previous connection has died for some reason."
p vec
(min
pos (with-current-buffer (process-buffer p) (point-max)))
- tramp-actions-before-shell
- (or connection-timeout tramp-connection-timeout))
+ tramp-actions-before-shell connection-timeout)
(tramp-message
vec 3 "Found remote shell prompt on `%s'" l-host)
@@ -5558,8 +5563,8 @@ raises an error."
string
""))
-(defun tramp-make-copy-program-file-name (vec)
- "Create a file name suitable for `scp', `pscp', or `nc' and workalikes."
+(defun tramp-make-copy-file-name (vec)
+ "Create a file name suitable for out-of-band methods."
(let ((method (tramp-file-name-method vec))
(user (tramp-file-name-user vec))
(host (tramp-file-name-host vec))
@@ -5570,13 +5575,13 @@ raises an error."
;; This does not work for MS Windows scp, if there are characters
;; to be quoted. OpenSSH 8 supports disabling of strict file name
;; checking in scp, we use it when available.
- (unless (string-match-p (rx "ftp" eos) method)
+ (unless (string-match-p (rx (| "dockercp" "podmancp" "ftp") eos) method)
(setq localname (tramp-unquote-shell-quote-argument localname)))
- (cond
- ((tramp-get-method-parameter vec 'tramp-remote-copy-program)
- localname)
- ((tramp-string-empty-or-nil-p user) (format "%s:%s" host localname))
- (t (format "%s@%s:%s" user host localname)))))
+ (string-join
+ (apply #'tramp-expand-args vec
+ 'tramp-copy-file-name tramp-default-copy-file-name
+ (list ?h (or host "") ?u (or user "") ?f localname))
+ "")))
(defun tramp-method-out-of-band-p (vec size)
"Return t if this is an out-of-band method, nil otherwise."
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index 8dad599c7e7..d0d56b8967e 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -322,7 +322,7 @@ arguments to pass to the OPERATION."
v (tramp-get-method-parameter v 'tramp-login-program)
nil outbuf display
(tramp-expand-args
- v 'tramp-login-args
+ v 'tramp-login-args nil
?h (or (tramp-file-name-host v) "")
?u (or (tramp-file-name-user v) "")
?p (or (tramp-file-name-port v) "")
@@ -424,7 +424,7 @@ connection if a previous connection has died for some reason."
(tramp-fuse-mount-spec vec)
(tramp-fuse-mount-point vec)
(tramp-expand-args
- vec 'tramp-mount-args
+ vec 'tramp-mount-args nil
?p (or (tramp-file-name-port vec) ""))))))
(tramp-error
vec 'file-error "Error mounting %s" (tramp-fuse-mount-spec vec)))
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 0c717c4a5aa..7bbfec62753 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -771,7 +771,7 @@ in case of error, t otherwise."
(tramp-get-connection-name vec) (current-buffer)
(append
(tramp-expand-args
- vec 'tramp-sudo-login
+ vec 'tramp-sudo-login nil
?h (or (tramp-file-name-host vec) "")
?u (or (tramp-file-name-user vec) ""))
(flatten-tree args))))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 2f6b526039f..5b101000926 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -67,11 +67,6 @@
(declare-function file-notify-rm-watch "filenotify")
(declare-function netrc-parse "netrc")
(defvar auto-save-file-name-transforms)
-(defvar ls-lisp-dirs-first)
-(defvar ls-lisp-emulation)
-(defvar ls-lisp-ignore-case)
-(defvar ls-lisp-use-insert-directory-program)
-(defvar ls-lisp-verbosity)
(defvar tramp-prefix-format)
(defvar tramp-prefix-regexp)
(defvar tramp-method-regexp)
@@ -219,7 +214,7 @@ pair of the form (KEY VALUE). The following KEYs are defined:
set this to any value other than \"/bin/sh\": Tramp wants to
use a shell which groks tilde expansion, but it can search
for it. Also note that \"/bin/sh\" exists on all Unixen
- except Andtoid, this might not be true for the value that you
+ except Android, this might not be true for the value that you
decide to use. You Have Been Warned.
* `tramp-remote-shell-login'
@@ -306,6 +301,15 @@ pair of the form (KEY VALUE). The following KEYs are defined:
This specifies the list of parameters to pass to the above mentioned
program, the hints for `tramp-login-args' also apply here.
+ * `tramp-copy-file-name'
+ The remote source or destination file name for out-of-band methods.
+ You can use \"%u\" and \"%h\" like in `tramp-login-args'.
+ Additionally, \"%f\" denotes the local file name part. This list
+ will be expanded to a string without spaces between the elements of
+ the list.
+
+ The default value is `tramp-default-copy-file-name'.
+
* `tramp-copy-env'
A list of environment variables and their values, which will
be set when calling `tramp-copy-program'.
@@ -320,8 +324,8 @@ pair of the form (KEY VALUE). The following KEYs are defined:
chosen port for the remote listener.
* `tramp-copy-keep-date'
- This specifies whether the copying program when the preserves the
- timestamp of the original file.
+ This specifies whether the copying program preserves the timestamp
+ of the original file.
* `tramp-copy-keep-tmpfile'
This specifies whether a temporary local file shall be kept
@@ -562,7 +566,7 @@ host runs a restricted shell, it shall be added to this list, too."
eos)
"Host names which are regarded as local host.
If the local host runs a chrooted environment, set this to nil."
- :version "30.1"
+ :version "29.3"
:type '(choice (const :tag "Chrooted environment" nil)
(regexp :tag "Host regexp")))
@@ -750,9 +754,8 @@ The regexp should match at end of buffer."
;; A security key requires the user physically to touch the device
;; with their finger. We must tell it to the user.
-;; Added in OpenSSH 8.2. I've tested it with yubikey. Nitrokey and
-;; Titankey, which have also passed the tests, do not show such a
-;; message.
+;; Added in OpenSSH 8.2. I've tested it with Nitrokey, Titankey, and
+;; Yubikey.
(defcustom tramp-security-key-confirm-regexp
(rx bol (* "\r") "Confirm user presence for key " (* nonl) (* (any "\r\n")))
"Regular expression matching security key confirmation message.
@@ -775,6 +778,14 @@ The regexp should match at end of buffer."
:version "28.1"
:type 'regexp)
+;; Needed only for FIDO2 (residential) keys. Tested with Nitrokey and Yubikey.
+(defcustom tramp-security-key-pin-regexp
+ (rx bol (* "\r") (group "Enter PIN for " (* nonl)) (* (any "\r\n")))
+ "Regular expression matching security key PIN prompt.
+The regexp should match at end of buffer."
+ :version "29.3"
+ :type 'regexp)
+
(defcustom tramp-operation-not-permitted-regexp
(rx (| (: "preserving times" (* nonl)) "set mode") ":" (* blank)
"Operation not permitted")
@@ -1085,10 +1096,10 @@ Derived from `tramp-postfix-host-format'.")
(defconst tramp-localname-regexp (rx (* (not (any "\r\n"))) eos)
"Regexp matching localnames.")
-(defconst tramp-unknown-id-string "UNKNOWN"
+(defvar tramp-unknown-id-string "UNKNOWN"
"String used to denote an unknown user or group.")
-(defconst tramp-unknown-id-integer -1
+(defvar tramp-unknown-id-integer -1
"Integer used to denote an unknown user or group.")
;;;###tramp-autoload
@@ -1205,14 +1216,7 @@ The `ftp' syntax does not support methods.")
;; FIXME: This shouldn't be necessary.
(rx bos "/" (? "[" (* (not "]"))) 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))
- ;; We cannot use `tramp-prefix-regexp', because it starts with `bol'.
- (literal tramp-prefix-format)
+ (regexp tramp-prefix-regexp)
;; Optional multi-hops.
(* (regexp tramp-remote-file-name-spec-regexp)
@@ -1550,21 +1554,23 @@ LOCALNAME and HOP do not count."
(equal (tramp-file-name-unify vec1)
(tramp-file-name-unify vec2))))
-(defun tramp-get-method-parameter (vec param)
+(defun tramp-get-method-parameter (vec param &optional default)
"Return the method parameter PARAM.
If VEC is a vector, check first in connection properties.
Afterwards, check in `tramp-methods'. If the `tramp-methods'
-entry does not exist, return nil."
+entry does not exist, return DEFAULT."
(let ((hash-entry
(replace-regexp-in-string (rx bos "tramp-") "" (symbol-name param))))
(if (tramp-connection-property-p vec hash-entry)
;; We use the cached property.
(tramp-get-connection-property vec hash-entry)
;; Use the static value from `tramp-methods'.
- (when-let ((methods-entry
+ (if-let ((methods-entry
(assoc
param (assoc (tramp-file-name-method vec) tramp-methods))))
- (cadr methods-entry)))))
+ (cadr methods-entry)
+ ;; Return the default value.
+ default))))
;; The localname can be quoted with "/:". Extract this.
(defun tramp-file-name-unquote-localname (vec)
@@ -2081,7 +2087,7 @@ without a visible progress reporter."
(defmacro with-tramp-timeout (list &rest body)
"Like `with-timeout', but allow SECONDS to be nil.
-(fn (SECONDS TIMEOUT-FORMS...) BODY)"
+\(fn (SECONDS TIMEOUT-FORMS...) BODY)"
(declare (indent 1) (debug ((form body) body)))
(let ((seconds (car list))
(timeout-forms (cdr list)))
@@ -2666,7 +2672,7 @@ not in completion mode."
(string-match-p (rx (regexp tramp-postfix-host-regexp) eos) dir))
(concat dir filename))
((string-match-p
- (rx bos (regexp tramp-prefix-regexp)
+ (rx (regexp tramp-prefix-regexp)
(* (regexp tramp-remote-file-name-spec-regexp)
(regexp tramp-postfix-hop-regexp))
(? (regexp tramp-method-regexp) (regexp tramp-postfix-method-regexp)
@@ -3198,7 +3204,7 @@ Host is always \"localhost\"."
(when (zerop (tramp-call-process nil "getent" nil t nil "passwd"))
(goto-char (point-min))
(cl-loop while (not (eobp)) collect
- (tramp-parse-etc-group-group))))
+ (tramp-parse-passwd-group))))
(tramp-parse-file filename #'tramp-parse-passwd-group))))
(defun tramp-parse-passwd-group ()
@@ -3948,6 +3954,9 @@ Let-bind it when necessary.")
(tramp-get-method-parameter v 'tramp-case-insensitive)
;; There isn't. So we must check, in case there's a connection already.
+ ;; Note: We cannot use it as DEFAULT value of
+ ;; `tramp-get-method-parameter', because it would be evalled
+ ;; during the call.
(and (let ((non-essential t)) (tramp-connectable-p v))
(with-tramp-connection-property v "case-insensitive"
(ignore-errors
@@ -4196,6 +4205,11 @@ Let-bind it when necessary.")
(filename switches &optional wildcard full-directory-p)
"Like `insert-directory' for Tramp files."
(require 'ls-lisp)
+ (defvar ls-lisp-dirs-first)
+ (defvar ls-lisp-emulation)
+ (defvar ls-lisp-ignore-case)
+ (defvar ls-lisp-use-insert-directory-program)
+ (defvar ls-lisp-verbosity)
(unless switches (setq switches ""))
;; Mark trailing "/".
(when (and (directory-name-p filename)
@@ -4752,15 +4766,15 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.")
(defvar tramp-extra-expand-args nil
"Method specific arguments.")
-(defun tramp-expand-args (vec parameter &rest spec-list)
+(defun tramp-expand-args (vec parameter default &rest spec-list)
"Expand login arguments as given by PARAMETER in `tramp-methods'.
PARAMETER is a symbol like `tramp-login-args', denoting a list of
list of strings from `tramp-methods', containing %-sequences for
-substitution.
+substitution. DEFAULT is used when PARAMETER is not specified.
SPEC-LIST is a list of char/value pairs used for
`format-spec-make'. It is appended by `tramp-extra-expand-args',
a connection-local variable."
- (let ((args (tramp-get-method-parameter vec parameter))
+ (let ((args (tramp-get-method-parameter vec parameter default))
(extra-spec-list
(mapcar
#'eval
@@ -4939,7 +4953,7 @@ a connection-local variable."
(mapcar
(lambda (x) (split-string x " "))
(tramp-expand-args
- v 'tramp-login-args
+ v 'tramp-login-args nil
?h (or host "") ?u (or user "") ?p (or port "")
?c (format-spec (or options "") (format-spec-make ?t tmpfile))
?d (or device "") ?a (or pta "") ?l ""))))
@@ -5442,7 +5456,7 @@ of."
prompt)
(goto-char (point-min))
(tramp-check-for-regexp proc tramp-process-action-regexp)
- (setq prompt (concat (match-string 1) " "))
+ (setq prompt (concat (string-trim (match-string 1)) " "))
(tramp-message vec 3 "Sending %s" (match-string 1))
;; We don't call `tramp-send-string' in order to hide the
;; password from the debug buffer and the traces.
@@ -5518,14 +5532,16 @@ Wait, until the connection buffer changes."
(ignore set-message-function clear-message-function)
(tramp-message vec 6 "\n%s" (buffer-string))
(tramp-check-for-regexp proc tramp-process-action-regexp)
- (with-temp-message
- (replace-regexp-in-string (rx (any "\r\n")) "" (match-string 0))
+ (with-temp-message (concat (string-trim (match-string 0)) " ")
;; Hide message in buffer.
(narrow-to-region (point-max) (point-max))
;; Wait for new output.
(while (not (ignore-error file-error
(tramp-wait-for-regexp
- proc 0.1 tramp-security-key-confirmed-regexp)))
+ proc 0.1
+ (rx (| (regexp tramp-security-key-confirmed-regexp)
+ (regexp tramp-security-key-pin-regexp)
+ (regexp tramp-security-key-timeout-regexp))))))
(when (tramp-check-for-regexp proc tramp-security-key-timeout-regexp)
(throw 'tramp-action 'timeout))
(redisplay 'force))))))
@@ -6324,9 +6340,8 @@ This handles also chrooted environments, which are not regarded as local."
(defun tramp-get-remote-tmpdir (vec)
"Return directory for temporary files on the remote host identified by VEC."
(with-tramp-connection-property (tramp-get-process vec) "remote-tmpdir"
- (let ((dir
- (tramp-make-tramp-file-name
- vec (or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp"))))
+ (let ((dir (tramp-make-tramp-file-name
+ vec (tramp-get-method-parameter vec 'tramp-tmpdir "/tmp"))))
(or (and (file-directory-p dir) (file-writable-p dir)
(tramp-file-local-name dir))
(tramp-error vec 'file-error "Directory %s not accessible" dir))
@@ -6571,12 +6586,13 @@ Consults the auth-source package."
(tramp-get-connection-property key "login-as")))
(host (tramp-file-name-host-port vec))
(pw-prompt
- (or prompt
- (with-current-buffer (process-buffer proc)
- (tramp-check-for-regexp proc tramp-password-prompt-regexp)
- (if (string-match-p "passphrase" (match-string 1))
- (match-string 0)
- (format "%s for %s " (capitalize (match-string 1)) key)))))
+ (string-trim-left
+ (or prompt
+ (with-current-buffer (process-buffer proc)
+ (tramp-check-for-regexp proc tramp-password-prompt-regexp)
+ (if (string-match-p "passphrase" (match-string 1))
+ (match-string 0)
+ (format "%s for %s " (capitalize (match-string 1)) key))))))
(auth-source-creation-prompts `((secret . ,pw-prompt)))
;; Use connection-local value.
(auth-sources (buffer-local-value 'auth-sources (process-buffer proc)))
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index bfabbbeaf34..c131d39c110 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -7,7 +7,7 @@
;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; Package: tramp
-;; Version: 2.7.0-pre
+;; Version: 2.7.1-pre
;; Package-Requires: ((emacs "27.1"))
;; Package-Type: multi
;; URL: https://www.gnu.org/software/tramp/
@@ -40,7 +40,7 @@
;; ./configure" to change them.
;;;###tramp-autoload
-(defconst tramp-version "2.7.0-pre"
+(defconst tramp-version "2.7.1-pre"
"This version of Tramp.")
;;;###tramp-autoload
@@ -78,7 +78,7 @@
;; Check for Emacs version.
(let ((x (if (not (string-version-lessp emacs-version "27.1"))
"ok"
- (format "Tramp 2.7.0-pre is not fit for %s"
+ (format "Tramp 2.7.1-pre is not fit for %s"
(replace-regexp-in-string "\n" "" (emacs-version))))))
(unless (string-equal "ok" x) (error "%s" x)))
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-02 10:15:18 +0000