summaryrefslogtreecommitdiff
path: root/lisp/net
diff options
context:
space:
mode:
authorAlan Mackenzie <acm@muc.de>2022-01-22 11:02:50 +0000
committerAlan Mackenzie <acm@muc.de>2022-01-22 11:02:50 +0000
commit14d64a8adcc866deecd758b898e8ef2d836b354a (patch)
tree83cff9669e266f8e283ccb8cd7518e909240f1e1 /lisp/net
parentbdd9b5b8a0d37dd09ee530c1dab3a44bee09e0f8 (diff)
parentebe334cdc234de2897263aed4c05ac7088c11857 (diff)
downloademacs-scratch/correct-warning-pos.tar.gz
Merge branch 'master' into scratch/correct-warning-posscratch/correct-warning-pos
Diffstat (limited to 'lisp/net')
-rw-r--r--lisp/net/dictionary.el2
-rw-r--r--lisp/net/mailcap.el72
-rw-r--r--lisp/net/shr.el13
-rw-r--r--lisp/net/tramp-adb.el10
-rw-r--r--lisp/net/tramp-archive.el5
-rw-r--r--lisp/net/tramp-cache.el2
-rw-r--r--lisp/net/tramp-sh.el24
-rw-r--r--lisp/net/tramp-smb.el5
-rw-r--r--lisp/net/tramp-sshfs.el38
-rw-r--r--lisp/net/tramp-sudoedit.el3
-rw-r--r--lisp/net/tramp.el88
11 files changed, 157 insertions, 105 deletions
diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el
index 507363cc0f8..e0824f39716 100644
--- a/lisp/net/dictionary.el
+++ b/lisp/net/dictionary.el
@@ -1376,7 +1376,7 @@ any buffer where (dictionary-tooltip-mode 1) has been called."
(dictionary-search word)))
;;;###autoload
-(defun context-menu-dictionary (menu click)
+(defun dictionary-context-menu (menu click)
"Populate MENU with dictionary commands at CLICK.
When you add this function to `context-menu-functions',
the context menu will contain an item that searches
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index daa2d5a3fb3..b65f7c25b83 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -319,8 +319,9 @@ attribute name (viewer, test, etc). This looks like:
Where VIEWERINFO specifies how the content-type is viewed. Can be
a string, in which case it is run through a shell, with appropriate
-parameters, or a symbol, in which case the symbol is `funcall'ed if
-and only if it exists as a function, with the buffer as an argument.
+parameters, or a symbol, in which case the symbol must name a function
+of zero arguments which is called in a buffer holding the MIME part's
+content.
TESTINFO is a test for the viewer's applicability, or nil. If nil, it
means the viewer is always valid. If it is a Lisp function, it is
@@ -1175,34 +1176,45 @@ See \"~/.mailcap\", `mailcap-mime-data' and related files and variables."
(mailcap-parse-mailcaps)
(let ((command (mailcap-mime-info
(mailcap-extension-to-mime (file-name-extension file)))))
- (unless command
- (error "No viewer for %s" (file-name-extension file)))
- ;; Remove quotes around the file name - we'll use shell-quote-argument.
- (while (string-match "['\"]%s['\"]" command)
- (setq command (replace-match "%s" t t command)))
- (setq command (replace-regexp-in-string
- "%s"
- (shell-quote-argument (convert-standard-filename file))
- command
- nil t))
- ;; Handlers such as "gio open" and kde-open5 start viewer in background
- ;; and exit immediately. Avoid `start-process' since it assumes
- ;; :connection-type `pty' and kills children processes with SIGHUP
- ;; when temporary terminal session is finished (Bug#44824).
- ;; An alternative is `process-connection-type' let-bound to nil for
- ;; `start-process-shell-command' call (with no chance to report failure).
- (make-process
- :name "mailcap-view-file"
- :connection-type 'pipe
- :buffer nil ; "*Messages*" may be suitable for debugging
- :sentinel (lambda (proc event)
- (when (and (memq (process-status proc) '(exit signal))
- (/= (process-exit-status proc) 0))
- (message
- "Command %s: %s."
- (mapconcat #'identity (process-command proc) " ")
- (substring event 0 -1))))
- :command (list shell-file-name shell-command-switch command))))
+ (if (functionp command)
+ ;; command is a viewer function (a mode) expecting the file
+ ;; contents to be in the current buffer.
+ (let ((buf (generate-new-buffer (file-name-nondirectory file))))
+ (set-buffer buf)
+ (insert-file-contents file)
+ (setq buffer-file-name file)
+ (funcall command)
+ (set-buffer-modified-p nil)
+ (pop-to-buffer buf))
+ ;; command is a program to run with file as an argument.
+ (unless command
+ (error "No viewer for %s" (file-name-extension file)))
+ ;; Remove quotes around the file name - we'll use shell-quote-argument.
+ (while (string-match "['\"]%s['\"]" command)
+ (setq command (replace-match "%s" t t command)))
+ (setq command (replace-regexp-in-string
+ "%s"
+ (shell-quote-argument (convert-standard-filename file))
+ command
+ nil t))
+ ;; Handlers such as "gio open" and kde-open5 start viewer in background
+ ;; and exit immediately. Avoid `start-process' since it assumes
+ ;; :connection-type `pty' and kills children processes with SIGHUP
+ ;; when temporary terminal session is finished (Bug#44824).
+ ;; An alternative is `process-connection-type' let-bound to nil for
+ ;; `start-process-shell-command' call (with no chance to report failure).
+ (make-process
+ :name "mailcap-view-file"
+ :connection-type 'pipe
+ :buffer nil ; "*Messages*" may be suitable for debugging
+ :sentinel (lambda (proc event)
+ (when (and (memq (process-status proc) '(exit signal))
+ (/= (process-exit-status proc) 0))
+ (message
+ "Command %s: %s."
+ (mapconcat #'identity (process-command proc) " ")
+ (substring event 0 -1))))
+ :command (list shell-file-name shell-command-switch command)))))
(provide 'mailcap)
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 7363874cf3c..ff14acfda70 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -1467,7 +1467,18 @@ ones, in case fg and bg are nil."
(dom-attr dom 'name)))) ; Obsolete since HTML5.
(push (cons id (point)) shr--link-targets))
(when url
- (shr-urlify (or shr-start start) (shr-expand-url url) title))))
+ (shr-urlify (or shr-start start) (shr-expand-url url) title)
+ ;; Check whether the URL is suspicious.
+ (when-let ((warning (or (textsec-suspicious-p
+ (shr-expand-url url) 'url)
+ (textsec-suspicious-p
+ (cons (shr-expand-url url)
+ (buffer-substring (or shr-start start)
+ (point)))
+ 'link))))
+ (add-text-properties (or shr-start start) (point)
+ (list 'face '(shr-link textsec-suspicious)))
+ (insert (propertize "⚠️" 'help-echo warning))))))
(defun shr-tag-abbr (dom)
(let ((title (dom-attr dom 'title))
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index ed73a86ef03..75e6b7179b0 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -776,7 +776,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(defun tramp-adb-get-signal-strings (vec)
"Strings to return by `process-file' in case of signals."
(with-tramp-connection-property vec "signal-strings"
- (let ((default-directory (tramp-make-tramp-file-name vec 'localname))
+ (let ((default-directory (tramp-make-tramp-file-name vec 'noloc))
;; `shell-file-name' and `shell-command-switch' are needed
;; for Emacs < 27.1, which doesn't support connection-local
;; variables in `shell-command'.
@@ -815,7 +815,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; Determine input.
(if (null infile)
(setq input (tramp-get-remote-null-device v))
- (setq infile (expand-file-name infile))
+ (setq infile (tramp-compat-file-name-unquote (expand-file-name infile)))
(if (tramp-equal-remote default-directory infile)
;; INFILE is on the same remote host.
(setq input (tramp-file-local-name infile))
@@ -870,7 +870,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setq ret (tramp-adb-send-command-and-check
v (format
"(cd %s; %s)"
- (tramp-shell-quote-argument localname) command)
+ (tramp-unquote-shell-quote-argument localname)
+ command)
t))
(unless (natnump ret) (setq ret 1))
;; We should add the output anyway.
@@ -900,8 +901,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; Cleanup. We remove all file cache values for the connection,
;; because the remote process could have changed them.
(when tmpinput (delete-file tmpinput))
-
- (unless process-file-side-effects
+ (when process-file-side-effects
(tramp-flush-directory-properties v ""))
;; Return exit status.
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index 8a88057d38a..d3f427932f3 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -457,7 +457,7 @@ name is kept in slot `hop'"
((tramp-archive-file-name-p archive)
(let ((archive
(tramp-make-tramp-file-name
- (tramp-archive-dissect-file-name archive) nil 'noarchive)))
+ (tramp-archive-dissect-file-name archive))))
(setf (tramp-file-name-host vec) (tramp-archive-gvfs-host archive)))
(puthash archive (list vec) tramp-archive-hash))
@@ -560,8 +560,7 @@ offered."
(defun tramp-archive-gvfs-file-name (name)
"Return NAME in GVFS syntax."
- (tramp-make-tramp-file-name
- (tramp-archive-dissect-file-name name) nil 'nohop))
+ (tramp-make-tramp-file-name (tramp-archive-dissect-file-name name)))
;; File name primitives.
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 715b537247f..1ab8f4d335b 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -124,7 +124,7 @@ If KEY is `tramp-cache-undefined', don't create anything, and return nil."
(dolist (elt tramp-connection-properties)
(when (tramp-compat-string-search
(or (nth 0 elt) "")
- (tramp-make-tramp-file-name key 'noloc 'nohop))
+ (tramp-make-tramp-file-name key 'noloc))
(tramp-set-connection-property key (nth 1 elt) (nth 2 elt)))))
hash))))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 72b1ebb3e06..f0ceabe568b 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1149,8 +1149,7 @@ component is used as the target of the symlink."
(when (file-remote-p result)
(setq result (tramp-compat-file-name-quote result 'top)))
(tramp-message v 4 "True name of `%s' is `%s'" localname result)
- result))
- 'nohop)))))
+ result)))))))
;; Basic functions.
@@ -2852,7 +2851,7 @@ implementation will be used."
;; `shell'. We discard hops, if existing, that's why
;; we cannot use `file-remote-p'.
(prompt (format "PS1=%s %s"
- (tramp-make-tramp-file-name v nil 'nohop)
+ (tramp-make-tramp-file-name v)
tramp-initial-end-of-output))
;; We use as environment the difference to toplevel
;; `process-environment'.
@@ -3013,7 +3012,7 @@ implementation will be used."
vec
(concat
"signal-strings-" (tramp-get-method-parameter vec 'tramp-remote-shell))
- (let ((default-directory (tramp-make-tramp-file-name vec 'localname))
+ (let ((default-directory (tramp-make-tramp-file-name vec 'noloc))
process-file-return-signal-string signals res result)
(setq signals
(append
@@ -3098,13 +3097,13 @@ implementation will be used."
;; Determine input.
(if (null infile)
(setq input (tramp-get-remote-null-device v))
- (setq infile (expand-file-name infile))
+ (setq infile (tramp-compat-file-name-unquote (expand-file-name infile)))
(if (tramp-equal-remote default-directory infile)
;; INFILE is on the same remote host.
(setq input (tramp-file-local-name infile))
;; INFILE must be copied to remote host.
(setq input (tramp-make-tramp-temp-file v)
- tmpinput (tramp-make-tramp-file-name v input 'nohop))
+ tmpinput (tramp-make-tramp-file-name v input))
(copy-file infile tmpinput t)))
(when input (setq command (format "%s <%s" command input)))
@@ -3136,7 +3135,7 @@ implementation will be used."
;; stderr must be copied to remote host. The temporary
;; file must be deleted after execution.
(setq stderr (tramp-make-tramp-temp-file v)
- tmpstderr (tramp-make-tramp-file-name v stderr 'nohop))))
+ tmpstderr (tramp-make-tramp-file-name v stderr))))
;; stderr to be discarded.
((null (cadr destination))
(setq stderr (tramp-get-remote-null-device v)))))
@@ -3153,7 +3152,8 @@ implementation will be used."
(setq ret (tramp-send-command-and-check
v (format
"cd %s && %s"
- (tramp-shell-quote-argument localname) command)
+ (tramp-unquote-shell-quote-argument localname)
+ command)
t t t))
(unless (natnump ret) (setq ret 1))
;; We should add the output anyway.
@@ -3184,8 +3184,7 @@ implementation will be used."
;; Cleanup. We remove all file cache values for the connection,
;; because the remote process could have changed them.
(when tmpinput (delete-file tmpinput))
-
- (unless process-file-side-effects
+ (when process-file-side-effects
(tramp-flush-directory-properties v ""))
;; Return exit status.
@@ -3650,8 +3649,7 @@ Fall back to normal file name handler if no Tramp handler exists."
(defun tramp-sh-file-name-handler-p (vec)
"Whether VEC uses a method from `tramp-sh-file-name-handler'."
(and (assoc (tramp-file-name-method vec) tramp-methods)
- (eq (tramp-find-foreign-file-name-handler
- (tramp-make-tramp-file-name vec nil 'nohop))
+ (eq (tramp-find-foreign-file-name-handler vec)
'tramp-sh-file-name-handler)))
;; This must be the last entry, because `identity' always matches.
@@ -5441,7 +5439,7 @@ Nonexistent directories are removed from spec."
(lambda (x)
(and
(stringp x)
- (file-directory-p (tramp-make-tramp-file-name vec x 'nohop))
+ (file-directory-p (tramp-make-tramp-file-name vec x))
x))
remote-path))))))
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index c5f423fa3f0..6515519680c 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1281,7 +1281,7 @@ component is used as the target of the symlink."
;; Determine input.
(when infile
- (setq infile (expand-file-name infile))
+ (setq infile (tramp-compat-file-name-unquote (expand-file-name infile)))
(if (tramp-equal-remote default-directory infile)
;; INFILE is on the same remote host.
(setq input (tramp-file-local-name infile))
@@ -1373,8 +1373,7 @@ component is used as the target of the symlink."
(when tmpinput (delete-file tmpinput))
(unless outbuf
(kill-buffer (tramp-get-connection-property v "process-buffer" nil)))
-
- (unless process-file-side-effects
+ (when process-file-side-effects
(tramp-flush-directory-properties v ""))
;; Return exit status.
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index 0a5bf2f43b3..72837793de4 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -137,7 +137,7 @@
(set-file-acl . ignore)
(set-file-modes . tramp-sshfs-handle-set-file-modes)
(set-file-selinux-context . ignore)
- (set-file-times . ignore)
+ (set-file-times . tramp-sshfs-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)
@@ -242,13 +242,28 @@ arguments to pass to the OPERATION."
(let ((command
(format
"cd %s && exec %s"
- localname
- (mapconcat #'tramp-shell-quote-argument (cons program args) " "))))
+ (tramp-unquote-shell-quote-argument localname)
+ (mapconcat #'tramp-shell-quote-argument (cons program args) " ")))
+ input tmpinput)
+
+ ;; Determine input.
+ (if (null infile)
+ (setq input (tramp-get-remote-null-device v))
+ (setq infile (tramp-compat-file-name-unquote (expand-file-name infile)))
+ (if (tramp-equal-remote default-directory infile)
+ ;; INFILE is on the same remote host.
+ (setq input (tramp-file-local-name infile))
+ ;; INFILE must be copied to remote host.
+ (setq input (tramp-make-tramp-temp-file v)
+ tmpinput (tramp-make-tramp-file-name v input))
+ (copy-file infile tmpinput t)))
+ (when input (setq command (format "%s <%s" command input)))
+
(unwind-protect
(apply
#'tramp-call-process
v (tramp-get-method-parameter v 'tramp-login-program)
- infile destination display
+ nil destination display
(tramp-expand-args
v 'tramp-login-args
?h (or (tramp-file-name-host v) "")
@@ -256,7 +271,11 @@ arguments to pass to the OPERATION."
?p (or (tramp-file-name-port v) "")
?l command))
- (unless process-file-side-effects
+ ;; Cleanup. We remove all file cache values for the
+ ;; connection, because the remote process could have changed
+ ;; them.
+ (when tmpinput (delete-file tmpinput))
+ (when process-file-side-effects
(tramp-flush-directory-properties v ""))))))
(defun tramp-sshfs-handle-rename-file
@@ -285,6 +304,15 @@ arguments to pass to the OPERATION."
(tramp-compat-set-file-modes
(tramp-fuse-local-file-name filename) mode flag))))
+(defun tramp-sshfs-handle-set-file-times (filename &optional timestamp flag)
+ "Like `set-file-times' for Tramp files."
+ (or (file-exists-p filename) (write-region "" nil filename nil 0))
+ (with-parsed-tramp-file-name filename nil
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (tramp-flush-file-properties v localname)
+ (tramp-compat-set-file-times
+ (tramp-fuse-local-file-name filename) timestamp flag))))
+
(defun tramp-sshfs-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index a68d4b3e365..7fbe5412709 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -572,8 +572,7 @@ the result will be a local, non-Tramp, file name."
(when (file-remote-p result)
(setq result (tramp-compat-file-name-quote result 'top)))
(tramp-message v 4 "True name of `%s' is `%s'" localname result)
- result))
- 'nohop)))))
+ result)))))))
(defun tramp-sudoedit-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 7d6157ed8c2..b258121549d 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1713,13 +1713,10 @@ See `tramp-dissect-file-name' for details."
"Construct a Tramp file name from ARGS.
ARGS could have two different signatures. The first one is of
-type (VEC &optional LOCALNAME HOP).
+type (VEC &optional LOCALNAME).
If LOCALNAME is nil, the value in VEC is used. If it is a
symbol, a null localname will be used. Otherwise, LOCALNAME is
expected to be a string, which will be used.
-If HOP is nil, the value in VEC is used. If it is a symbol, a
-null hop will be used. Otherwise, HOP is expected to be a
-string, which will be used.
The other signature exists for backward compatibility. It has
the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)."
@@ -1735,8 +1732,13 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)."
hop (tramp-file-name-hop (car args)))
(when (cadr args)
(setq localname (and (stringp (cadr args)) (cadr args))))
- (when (cl-caddr args)
- (setq hop (and (stringp (cl-caddr args)) (cl-caddr args)))))
+ (when hop
+ (setq hop nil)
+ ;; Assure that the hops are in `tramp-default-proxies-alist'.
+ ;; In tramp-archive.el, the slot `hop' is used for the archive
+ ;; file name.
+ (unless (string-equal method "archive")
+ (tramp-add-hops (car args)))))
(t (setq method (nth 0 args)
user (nth 1 args)
@@ -1769,15 +1771,17 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)."
localname)))
(set-advertised-calling-convention
- #'tramp-make-tramp-file-name '(vec &optional localname hop) "27.1")
+ #'tramp-make-tramp-file-name '(vec &optional localname) "29.1")
(defun tramp-make-tramp-hop-name (vec)
"Construct a Tramp hop name from VEC."
- (replace-regexp-in-string
- tramp-prefix-regexp ""
+ (concat
+ (tramp-file-name-hop vec)
(replace-regexp-in-string
- (concat tramp-postfix-host-regexp "$") tramp-postfix-hop-format
- (tramp-make-tramp-file-name vec 'noloc))))
+ tramp-prefix-regexp ""
+ (replace-regexp-in-string
+ (concat tramp-postfix-host-regexp "$") tramp-postfix-hop-format
+ (tramp-make-tramp-file-name vec 'noloc)))))
(defun tramp-completion-make-tramp-file-name (method user host localname)
"Construct a Tramp file name from METHOD, USER, HOST and LOCALNAME.
@@ -1811,7 +1815,7 @@ Unless DONT-CREATE, the buffer is created when it doesn't exist yet."
(tramp-get-connection-property vec "process-buffer" nil))
(setq buffer-undo-list t
default-directory
- (tramp-make-tramp-file-name vec 'noloc 'nohop))
+ (tramp-make-tramp-file-name vec 'noloc))
(current-buffer)))))
(defun tramp-get-connection-buffer (vec &optional dont-create)
@@ -1926,7 +1930,7 @@ The outline level is equal to the verbosity of the Tramp message."
"A predicate for Tramp interactive commands.
They are completed by \"M-x TAB\" only in Tramp debug buffers."
(with-current-buffer buffer
- (string-equal (buffer-substring 1 10) ";; Emacs:")))
+ (string-equal (buffer-substring 1 (min 10 (point-max))) ";; Emacs:")))
(put #'tramp-debug-buffer-command-completion-p 'tramp-suppress-trace t)
@@ -2596,11 +2600,10 @@ Must be handled by the callers."
;; Unknown file primitive.
(t (error "Unknown file I/O primitive: %s" operation))))
-(defun tramp-find-foreign-file-name-handler (filename &optional _operation)
+(defun tramp-find-foreign-file-name-handler (vec &optional _operation)
"Return foreign file name handler if exists."
- (when (tramp-tramp-file-p filename)
+ (when (tramp-file-name-p vec)
(let ((handler tramp-foreign-file-name-handler-alist)
- (vec (tramp-dissect-file-name filename))
elt func res)
(while handler
(setq elt (car handler)
@@ -2633,7 +2636,7 @@ Fall back to normal file name handler if no Tramp file name handler exists."
(with-parsed-tramp-file-name filename nil
(let ((current-connection tramp-current-connection)
(foreign
- (tramp-find-foreign-file-name-handler filename operation))
+ (tramp-find-foreign-file-name-handler v operation))
(signal-hook-function #'tramp-signal-hook-function)
result)
;; Set `tramp-current-connection'.
@@ -3351,7 +3354,7 @@ User is always nil."
(tramp-compat-funcall 'directory-abbrev-make-regexp home-dir) filename)
(tramp-make-tramp-file-name
vec (concat "~" (substring filename (match-beginning 1))))
- filename)))
+ (tramp-make-tramp-file-name (tramp-dissect-file-name filename)))))
(defun tramp-handle-access-file (filename string)
"Like `access-file' for Tramp files."
@@ -3678,8 +3681,8 @@ User is always nil."
;; We do not want traces in the debug buffer.
(let ((tramp-verbose (min tramp-verbose 3)))
(when (tramp-tramp-file-p filename)
- (let* ((v (tramp-dissect-file-name filename))
- (p (tramp-get-connection-process v))
+ (let* ((o (tramp-dissect-file-name filename))
+ (p (tramp-get-connection-process o))
(c (and (process-live-p p)
(tramp-get-connection-property p "connected" nil))))
;; We expand the file name only, if there is already a connection.
@@ -3693,7 +3696,8 @@ User is always nil."
((eq identification 'user) (tramp-file-name-user-domain v))
((eq identification 'host) (tramp-file-name-host-port v))
((eq identification 'localname) localname)
- ((eq identification 'hop) hop)
+ ;; Hop exists only in original dissected file name.
+ ((eq identification 'hop) (tramp-file-name-hop o))
(t (tramp-make-tramp-file-name v 'noloc)))))))))
(defun tramp-handle-file-selinux-context (_filename)
@@ -3744,8 +3748,7 @@ User is always nil."
(expand-file-name
symlink-target
(file-name-directory v2-localname))))
- v2-localname)
- 'nohop)))
+ v2-localname))))
(when (>= numchase numchase-limit)
(tramp-error
v1 'file-error
@@ -3904,8 +3907,7 @@ User is always nil."
(cond
((stringp remote-copy)
(file-local-copy
- (tramp-make-tramp-file-name
- v remote-copy 'nohop)))
+ (tramp-make-tramp-file-name v remote-copy)))
((stringp tramp-temp-buffer-file-name)
(copy-file
filename tramp-temp-buffer-file-name 'ok)
@@ -3948,7 +3950,7 @@ User is always nil."
(or remote-copy (null tramp-temp-buffer-file-name)))
(delete-file local-copy))
(when (stringp remote-copy)
- (delete-file (tramp-make-tramp-file-name v remote-copy 'nohop))))
+ (delete-file (tramp-make-tramp-file-name v remote-copy))))
;; Result.
(cons filename (cdr result)))))
@@ -4088,15 +4090,10 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.")
(and (tramp-sh-file-name-handler-p vec)
(not (tramp-get-method-parameter vec 'tramp-copy-program))))
-(defun tramp-compute-multi-hops (vec)
- "Expands VEC according to `tramp-default-proxies-alist'."
- (let ((saved-tdpa tramp-default-proxies-alist)
- (target-alist `(,vec))
- (hops (or (tramp-file-name-hop vec) ""))
- (item vec)
- choices proxy)
-
- ;; Ad-hoc proxy definitions.
+(defun tramp-add-hops (vec)
+ "Add ad-hoc proxy definitions to `tramp-default-proxies-alist'."
+ (when-let ((hops (tramp-file-name-hop vec))
+ (item vec))
(dolist (proxy (reverse (split-string hops tramp-postfix-hop-regexp 'omit)))
(let* ((host-port (tramp-file-name-host-port item))
(user-domain (tramp-file-name-user-domain item))
@@ -4113,9 +4110,19 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.")
(add-to-list 'tramp-default-proxies-alist entry)
(setq item (tramp-dissect-file-name proxy))))
;; Save the new value.
- (when (and hops tramp-save-ad-hoc-proxies)
+ (when tramp-save-ad-hoc-proxies
(customize-save-variable
- 'tramp-default-proxies-alist tramp-default-proxies-alist))
+ 'tramp-default-proxies-alist tramp-default-proxies-alist))))
+
+(defun tramp-compute-multi-hops (vec)
+ "Expands VEC according to `tramp-default-proxies-alist'."
+ (let ((saved-tdpa tramp-default-proxies-alist)
+ (target-alist `(,vec))
+ (item vec)
+ choices proxy)
+
+ ;; Ad-hoc proxy definitions.
+ (tramp-add-hops vec)
;; Look for proxy hosts to be passed.
(setq choices tramp-default-proxies-alist)
@@ -5462,8 +5469,7 @@ This handles also chrooted environments, which are not regarded as local."
(null tramp-crypt-enabled)
;; The local temp directory must be writable for the other user.
(file-writable-p
- (tramp-make-tramp-file-name
- vec tramp-compat-temporary-file-directory 'nohop))
+ (tramp-make-tramp-file-name vec tramp-compat-temporary-file-directory))
;; On some systems, chown runs only for root.
(or (zerop (user-uid))
(zerop (tramp-get-remote-uid vec 'integer))))))
@@ -5712,7 +5718,7 @@ Invokes `password-read' if available, `read-passwd' else."
;; multi-hop.
(tramp-get-connection-property
proc "password-vector" (process-get proc 'vector))
- 'noloc 'nohop))
+ 'noloc))
(pw-prompt
(or prompt
(with-current-buffer (process-buffer proc)
@@ -5789,7 +5795,7 @@ Invokes `password-read' if available, `read-passwd' else."
(auth-source-forget
`(:max 1 ,(and user-domain :user) ,user-domain
:host ,host-port :port ,method))
- (password-cache-remove (tramp-make-tramp-file-name vec 'noloc 'nohop))))
+ (password-cache-remove (tramp-make-tramp-file-name vec 'noloc))))
(put #'tramp-clear-passwd 'tramp-suppress-trace t)