1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-17 03:10:58 -08:00

Introduce a defstruct `tramp-file-name' as central data structure.

This solves also Bug#27009.

* lisp/net/tramp.el (tramp-current-domain)
(tramp-current-port): New defvars.
(tramp-file-name): New defstruct.
(tramp-file-name-user-domain, tramp-file-name-host-port)
(tramp-file-name-equal-p): New defuns.
(tramp-file-name-p, tramp-file-name-method)
(tramp-file-name-user, tramp-file-name-host)
(tramp-file-name-localname, tramp-file-name-hop)
(tramp-file-name-real-user, tramp-file-name-domain)
(tramp-file-name-real-host, tramp-file-name-port):
Remove defuns.  They are provided by the defstruct, or not
needed anymore.
(tramp-dissect-file-name, tramp-buffer-name)
(tramp-make-tramp-file-name, tramp-get-buffer)
(tramp-set-connection-local-variables)
(tramp-debug-buffer-name, tramp-message)
(tramp-error-with-buffer, with-parsed-tramp-file-name)
(tramp-completion-dissect-file-name1)
(tramp-handle-file-name-as-directory)
(tramp-handle-file-name-directory)
(tramp-handle-file-remote-p, tramp-handle-file-symlink-p)
(tramp-handle-find-backup-file-name)
(tramp-handle-insert-file-contents, tramp-process-actions)
(tramp-check-cached-permissions, tramp-local-host-p)
(tramp-get-remote-tmpdir, tramp-call-process)
(tramp-call-process-region, tramp-read-passwd)
(tramp-clear-passwd):
* lisp/net/tramp-adb.el (tramp-adb-parse-device-names)
(tramp-adb-handle-expand-file-name)
(tramp-adb-handle-file-truename, tramp-adb-handle-copy-file)
(tramp-adb-handle-process-file)
(tramp-adb-maybe-open-connection):
* lisp/net/tramp-cache.el (tramp-get-hash-table)
(tramp-get-file-property, tramp-set-file-property)
(tramp-flush-file-property, tramp-flush-directory-property)
(tramp-get-connection-property)
(tramp-set-connection-property, tramp-connection-property-p)
(tramp-flush-connection-property, tramp-cache-print)
(tramp-list-connections, tramp-dump-connection-properties)
(tramp-parse-connection-properties):
* lisp/net/tramp-cmds.el (tramp-cleanup-connection):
* lisp/net/tramp-ftp.el (tramp-ftp-file-name-handler):
* lisp/net/tramp-gvfs.el (tramp-gvfs-handle-expand-file-name)
(tramp-gvfs-url-file-name, tramp-gvfs-handler-askpassword)
(tramp-gvfs-handler-mounted-unmounted)
(tramp-gvfs-mount-spec, tramp-gvfs-get-remote-uid)
(tramp-gvfs-get-remote-gid)
(tramp-gvfs-maybe-open-connection):
* lisp/net/tramp-sh.el (tramp-sh-handle-file-truename)
(tramp-do-copy-or-rename-file-out-of-band)
(tramp-sh-handle-expand-file-name)
(tramp-sh-handle-start-file-process)
(tramp-sh-handle-process-file, tramp-compute-multi-hops)
(tramp-maybe-open-connection)
(tramp-make-copy-program-file-name, tramp-get-remote-path)
(tramp-get-inline-coding):
* lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory)
(tramp-smb-handle-expand-file-name)
(tramp-smb-handle-file-acl, tramp-smb-handle-process-file)
(tramp-smb-handle-set-file-acl)
(tramp-smb-maybe-open-connection): Adapt according to defstruct.
This commit is contained in:
Michael Albinus 2017-05-24 16:16:53 +02:00
parent 08f00c01d6
commit dca22e86e0
8 changed files with 300 additions and 280 deletions

View file

@ -199,8 +199,9 @@ pass to the OPERATION."
;; That's why we use `start-process'. ;; That's why we use `start-process'.
(let ((p (start-process (let ((p (start-process
tramp-adb-program (current-buffer) tramp-adb-program "devices")) tramp-adb-program (current-buffer) tramp-adb-program "devices"))
(v (vector tramp-adb-method tramp-current-user (v (tramp-make-tramp-file-name
tramp-current-host nil nil)) tramp-adb-method tramp-current-user nil
tramp-current-host nil nil nil))
result) result)
(tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " ")) (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " "))
(process-put p 'adjust-window-size-function 'ignore) (process-put p 'adjust-window-size-function 'ignore)
@ -242,7 +243,7 @@ pass to the OPERATION."
;; be problems with UNC shares or Cygwin mounts. ;; be problems with UNC shares or Cygwin mounts.
(let ((default-directory (tramp-compat-temporary-file-directory))) (let ((default-directory (tramp-compat-temporary-file-directory)))
(tramp-make-tramp-file-name (tramp-make-tramp-file-name
method user host method user domain host port
(tramp-drop-volume-letter (tramp-drop-volume-letter
(tramp-run-real-handler (tramp-run-real-handler
'expand-file-name (list localname)))))))) 'expand-file-name (list localname))))))))
@ -261,7 +262,7 @@ pass to the OPERATION."
"%s%s" "%s%s"
(with-parsed-tramp-file-name (expand-file-name filename) nil (with-parsed-tramp-file-name (expand-file-name filename) nil
(tramp-make-tramp-file-name (tramp-make-tramp-file-name
method user host method user domain host port
(with-tramp-file-property v localname "file-truename" (with-tramp-file-property v localname "file-truename"
(let ((result nil)) ; result steps in reverse order (let ((result nil)) ; result steps in reverse order
(tramp-message v 4 "Finding true name for `%s'" filename) (tramp-message v 4 "Finding true name for `%s'" filename)
@ -289,7 +290,7 @@ pass to the OPERATION."
(tramp-compat-file-attribute-type (tramp-compat-file-attribute-type
(file-attributes (file-attributes
(tramp-make-tramp-file-name (tramp-make-tramp-file-name
method user host method user domain host port
(mapconcat 'identity (mapconcat 'identity
(append '("") (append '("")
(reverse result) (reverse result)
@ -687,7 +688,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
newname (expand-file-name newname)) newname (expand-file-name newname))
(if (file-directory-p filename) (if (file-directory-p filename)
(tramp-file-name-handler 'copy-directory filename newname keep-date t) (copy-directory filename newname keep-date t)
(let ((t1 (tramp-tramp-file-p filename)) (let ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname))) (t2 (tramp-tramp-file-p newname)))
@ -815,7 +816,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setq input (with-parsed-tramp-file-name infile nil localname)) (setq input (with-parsed-tramp-file-name infile nil localname))
;; INFILE must be copied to remote host. ;; INFILE must be copied to remote host.
(setq input (tramp-make-tramp-temp-file v) (setq input (tramp-make-tramp-temp-file v)
tmpinput (tramp-make-tramp-file-name method user host input)) tmpinput (tramp-make-tramp-file-name
method user domain host port input))
(copy-file infile tmpinput t))) (copy-file infile tmpinput t)))
(when input (setq command (format "%s <%s" command input))) (when input (setq command (format "%s <%s" command input)))
@ -849,7 +851,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; file must be deleted after execution. ;; file must be deleted after execution.
(setq stderr (tramp-make-tramp-temp-file v) (setq stderr (tramp-make-tramp-temp-file v)
tmpstderr (tramp-make-tramp-file-name tmpstderr (tramp-make-tramp-file-name
method user host stderr)))) method user domain host port stderr))))
;; stderr to be discarded. ;; stderr to be discarded.
((null (cadr destination)) ((null (cadr destination))
(setq stderr "/dev/null")))) (setq stderr "/dev/null"))))
@ -1199,8 +1201,7 @@ connection if a previous connection has died for some reason."
(device (tramp-adb-get-device vec))) (device (tramp-adb-get-device vec)))
;; Set variables for proper tracing in `tramp-adb-parse-device-names'. ;; Set variables for proper tracing in `tramp-adb-parse-device-names'.
(setq tramp-current-method (tramp-file-name-method vec) (setq tramp-current-user (tramp-file-name-user vec)
tramp-current-user (tramp-file-name-user vec)
tramp-current-host (tramp-file-name-host vec)) tramp-current-host (tramp-file-name-host vec))
;; Maybe we know already that "su" is not supported. We cannot ;; Maybe we know already that "su" is not supported. We cannot

View file

@ -27,9 +27,9 @@
;; An implementation of information caching for remote files. ;; An implementation of information caching for remote files.
;; Each connection, identified by a vector [method user host ;; Each connection, identified by a `tramp-file-name' structure or by
;; localname] or by a process, has a unique cache. We distinguish 3 ;; a process, has a unique cache. We distinguish 3 kind of caches,
;; kind of caches, depending on the key: ;; depending on the key:
;; ;;
;; - localname is NIL. This are reusable properties. Examples: ;; - localname is NIL. This are reusable properties. Examples:
;; "remote-shell" identifies the POSIX shell to be called on the ;; "remote-shell" identifies the POSIX shell to be called on the
@ -94,12 +94,14 @@ matching entries of `tramp-connection-properties'."
(or (gethash key tramp-cache-data) (or (gethash key tramp-cache-data)
(let ((hash (let ((hash
(puthash key (make-hash-table :test 'equal) tramp-cache-data))) (puthash key (make-hash-table :test 'equal) tramp-cache-data)))
(when (vectorp key) (when (tramp-file-name-p key)
(dolist (elt tramp-connection-properties) (dolist (elt tramp-connection-properties)
(when (string-match (when (string-match
(or (nth 0 elt) "") (or (nth 0 elt) "")
(tramp-make-tramp-file-name (tramp-make-tramp-file-name
(aref key 0) (aref key 1) (aref key 2) nil)) (tramp-file-name-method key) (tramp-file-name-user key)
(tramp-file-name-domain key) (tramp-file-name-host key)
(tramp-file-name-port key) nil))
(tramp-set-connection-property key (nth 1 elt) (nth 2 elt))))) (tramp-set-connection-property key (nth 1 elt) (nth 2 elt)))))
hash))) hash)))
@ -107,11 +109,12 @@ matching entries of `tramp-connection-properties'."
(defun tramp-get-file-property (key file property default) (defun tramp-get-file-property (key file property default)
"Get the PROPERTY of FILE from the cache context of KEY. "Get the PROPERTY of FILE from the cache context of KEY.
Returns DEFAULT if not set." Returns DEFAULT if not set."
;; Unify localname. Remove hop from vector. ;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq file (tramp-compat-file-name-unquote file)) (setq file (tramp-compat-file-name-unquote file)
(setq key (copy-sequence key)) key (copy-tramp-file-name key))
(aset key 3 (tramp-run-real-handler 'directory-file-name (list file))) (setf (tramp-file-name-localname key)
(aset key 4 nil) (tramp-run-real-handler 'directory-file-name (list file))
(tramp-file-name-hop key) nil)
(let* ((hash (tramp-get-hash-table key)) (let* ((hash (tramp-get-hash-table key))
(value (when (hash-table-p hash) (gethash property hash)))) (value (when (hash-table-p hash) (gethash property hash))))
(if (if
@ -141,11 +144,12 @@ Returns DEFAULT if not set."
(defun tramp-set-file-property (key file property value) (defun tramp-set-file-property (key file property value)
"Set the PROPERTY of FILE to VALUE, in the cache context of KEY. "Set the PROPERTY of FILE to VALUE, in the cache context of KEY.
Returns VALUE." Returns VALUE."
;; Unify localname. Remove hop from vector. ;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq file (tramp-compat-file-name-unquote file)) (setq file (tramp-compat-file-name-unquote file)
(setq key (copy-sequence key)) key (copy-tramp-file-name key))
(aset key 3 (tramp-run-real-handler 'directory-file-name (list file))) (setf (tramp-file-name-localname key)
(aset key 4 nil) (tramp-run-real-handler 'directory-file-name (list file))
(tramp-file-name-hop key) nil)
(let ((hash (tramp-get-hash-table key))) (let ((hash (tramp-get-hash-table key)))
;; We put the timestamp there. ;; We put the timestamp there.
(puthash property (cons (current-time) value) hash) (puthash property (cons (current-time) value) hash)
@ -162,11 +166,11 @@ Returns VALUE."
(let* ((file (tramp-run-real-handler (let* ((file (tramp-run-real-handler
'directory-file-name (list file))) 'directory-file-name (list file)))
(truename (tramp-get-file-property key file "file-truename" nil))) (truename (tramp-get-file-property key file "file-truename" nil)))
;; Unify localname. Remove hop from vector. ;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq file (tramp-compat-file-name-unquote file)) (setq file (tramp-compat-file-name-unquote file)
(setq key (copy-sequence key)) key (copy-tramp-file-name key))
(aset key 3 file) (setf (tramp-file-name-localname key) file
(aset key 4 nil) (tramp-file-name-hop key) nil)
(tramp-message key 8 "%s" file) (tramp-message key 8 "%s" file)
(remhash key tramp-cache-data) (remhash key tramp-cache-data)
;; Remove file properties of symlinks. ;; Remove file properties of symlinks.
@ -185,7 +189,8 @@ Remove also properties of all files in subdirectories."
(tramp-message key 8 "%s" directory) (tramp-message key 8 "%s" directory)
(maphash (maphash
(lambda (key _value) (lambda (key _value)
(when (and (stringp (tramp-file-name-localname key)) (when (and (tramp-file-name-p key)
(stringp (tramp-file-name-localname key))
(string-match (regexp-quote directory) (string-match (regexp-quote directory)
(tramp-file-name-localname key))) (tramp-file-name-localname key)))
(remhash key tramp-cache-data))) (remhash key tramp-cache-data)))
@ -232,15 +237,15 @@ This is suppressed for temporary buffers."
(defun tramp-get-connection-property (key property default) (defun tramp-get-connection-property (key property default)
"Get the named PROPERTY for the connection. "Get the named PROPERTY for the connection.
KEY identifies the connection, it is either a process or a KEY identifies the connection, it is either a process or a
vector. A special case is nil, which is used to cache connection `tramp-file-name' structure. A special case is nil, which is
properties of the local machine. If the value is not set for the used to cache connection properties of the local machine. If the
connection, returns DEFAULT." value is not set for the connection, returns DEFAULT."
;; Unify key by removing localname and hop from vector. Work with a ;; Unify key by removing localname and hop from `tramp-file-name'
;; copy in order to avoid side effects. ;; structure. Work with a copy in order to avoid side effects.
(when (vectorp key) (when (tramp-file-name-p key)
(setq key (copy-sequence key)) (setq key (copy-tramp-file-name key))
(aset key 3 nil) (setf (tramp-file-name-localname key) nil
(aset key 4 nil)) (tramp-file-name-hop key) nil))
(let* ((hash (tramp-get-hash-table key)) (let* ((hash (tramp-get-hash-table key))
(value (value
;; If the key is an auxiliary process object, check whether ;; If the key is an auxiliary process object, check whether
@ -257,15 +262,15 @@ connection, returns DEFAULT."
(defun tramp-set-connection-property (key property value) (defun tramp-set-connection-property (key property value)
"Set the named PROPERTY of a connection to VALUE. "Set the named PROPERTY of a connection to VALUE.
KEY identifies the connection, it is either a process or a KEY identifies the connection, it is either a process or a
vector. A special case is nil, which is used to cache connection `tramp-file-name' structure. A special case is nil, which is
properties of the local machine. PROPERTY is set persistent when used to cache connection properties of the local machine.
KEY is a vector." PROPERTY is set persistent when KEY is a `tramp-file-name' structure."
;; Unify key by removing localname and hop from vector. Work with a ;; Unify key by removing localname and hop from `tramp-file-name'
;; copy in order to avoid side effects. ;; structure. Work with a copy in order to avoid side effects.
(when (vectorp key) (when (tramp-file-name-p key)
(setq key (copy-sequence key)) (setq key (copy-tramp-file-name key))
(aset key 3 nil) (setf (tramp-file-name-localname key) nil
(aset key 4 nil)) (tramp-file-name-hop key) nil))
(let ((hash (tramp-get-hash-table key))) (let ((hash (tramp-get-hash-table key)))
(puthash property value hash) (puthash property value hash)
(setq tramp-cache-data-changed t) (setq tramp-cache-data-changed t)
@ -276,22 +281,22 @@ KEY is a vector."
(defun tramp-connection-property-p (key property) (defun tramp-connection-property-p (key property)
"Check whether named PROPERTY of a connection is defined. "Check whether named PROPERTY of a connection is defined.
KEY identifies the connection, it is either a process or a KEY identifies the connection, it is either a process or a
vector. A special case is nil, which is used to cache connection `tramp-file-name' structure. A special case is nil, which is
properties of the local machine." used to cache connection properties of the local machine."
(not (eq (tramp-get-connection-property key property 'undef) 'undef))) (not (eq (tramp-get-connection-property key property 'undef) 'undef)))
;;;###tramp-autoload ;;;###tramp-autoload
(defun tramp-flush-connection-property (key) (defun tramp-flush-connection-property (key)
"Remove all properties identified by KEY. "Remove all properties identified by KEY.
KEY identifies the connection, it is either a process or a KEY identifies the connection, it is either a process or a
vector. A special case is nil, which is used to cache connection `tramp-file-name' structure. A special case is nil, which is
properties of the local machine." used to cache connection properties of the local machine."
;; Unify key by removing localname and hop from vector. Work with a ;; Unify key by removing localname and hop from `tramp-file-name'
;; copy in order to avoid side effects. ;; structure. Work with a copy in order to avoid side effects.
(when (vectorp key) (when (tramp-file-name-p key)
(setq key (copy-sequence key)) (setq key (copy-tramp-file-name key))
(aset key 3 nil) (setf (tramp-file-name-localname key) nil
(aset key 4 nil)) (tramp-file-name-hop key) nil))
(tramp-message (tramp-message
key 7 "%s %s" key key 7 "%s %s" key
(let ((hash (gethash key tramp-cache-data)) (let ((hash (gethash key tramp-cache-data))
@ -310,7 +315,16 @@ properties of the local machine."
(maphash (maphash
(lambda (key value) (lambda (key value)
;; Remove text properties from KEY and VALUE. ;; Remove text properties from KEY and VALUE.
(when (vectorp key) ;; `cl-struct-slot-*' functions exist since Emacs 25 only; we
;; ignore errors.
(when (tramp-file-name-p key)
;; (dolist
;; (slot
;; (mapcar 'car (cdr (cl-struct-slot-info 'tramp-file-name))))
;; (when (stringp (cl-struct-slot-value 'tramp-file-name slot key))
;; (setf (cl-struct-slot-value 'tramp-file-name slot key)
;; (substring-no-properties
;; (cl-struct-slot-value 'tramp-file-name slot key))))))
(dotimes (i (length key)) (dotimes (i (length key))
(when (stringp (aref key i)) (when (stringp (aref key i))
(aset key i (substring-no-properties (aref key i)))))) (aset key i (substring-no-properties (aref key i))))))
@ -335,11 +349,12 @@ properties of the local machine."
;;;###tramp-autoload ;;;###tramp-autoload
(defun tramp-list-connections () (defun tramp-list-connections ()
"Return a list of all known connection vectors according to `tramp-cache'." "Return all known `tramp-file-name' structs according to `tramp-cache'."
(let (result tramp-verbose) (let (result tramp-verbose)
(maphash (maphash
(lambda (key _value) (lambda (key _value)
(when (and (vectorp key) (null (aref key 3)) (when (and (tramp-file-name-p key)
(null (tramp-file-name-localname key))
(tramp-connection-property-p key "process-buffer")) (tramp-connection-property-p key "process-buffer"))
(add-to-list 'result key))) (add-to-list 'result key)))
tramp-cache-data) tramp-cache-data)
@ -361,7 +376,7 @@ properties of the local machine."
;; possibility to use another login name later on. ;; possibility to use another login name later on.
(maphash (maphash
(lambda (key value) (lambda (key value)
(if (and (vectorp key) (if (and (tramp-file-name-p key)
(not (tramp-file-name-localname key)) (not (tramp-file-name-localname key))
(not (gethash "login-as" value))) (not (gethash "login-as" value)))
(progn (progn
@ -402,7 +417,7 @@ for all methods. Resulting data are derived from connection history."
(let (res) (let (res)
(maphash (maphash
(lambda (key _value) (lambda (key _value)
(if (and (vectorp key) (if (and (tramp-file-name-p key)
(string-equal method (tramp-file-name-method key)) (string-equal method (tramp-file-name-method key))
(not (tramp-file-name-localname key))) (not (tramp-file-name-localname key)))
(push (list (tramp-file-name-user key) (push (list (tramp-file-name-user key)
@ -427,12 +442,13 @@ for all methods. Resulting data are derived from connection history."
element key item) element key item)
(while (setq element (pop list)) (while (setq element (pop list))
(setq key (pop element)) (setq key (pop element))
(when (tramp-file-name-p key)
(while (setq item (pop element)) (while (setq item (pop element))
;; We set only values which are not contained in ;; We set only values which are not contained in
;; `tramp-connection-properties'. The cache is ;; `tramp-connection-properties'. The cache is
;; initialized properly by side effect. ;; initialized properly by side effect.
(unless (tramp-connection-property-p key (car item)) (unless (tramp-connection-property-p key (car item))
(tramp-set-connection-property key (pop item) (car item)))))) (tramp-set-connection-property key (pop item) (car item)))))))
(setq tramp-cache-data-changed nil)) (setq tramp-cache-data-changed nil))
(file-error (file-error
;; Most likely because the file doesn't exist yet. No message. ;; Most likely because the file doesn't exist yet. No message.

View file

@ -85,7 +85,9 @@ When called interactively, a Tramp connection has to be selected."
(tramp-make-tramp-file-name (tramp-make-tramp-file-name
(tramp-file-name-method x) (tramp-file-name-method x)
(tramp-file-name-user x) (tramp-file-name-user x)
(tramp-file-name-domain x)
(tramp-file-name-host x) (tramp-file-name-host x)
(tramp-file-name-port x)
(tramp-file-name-localname x))) (tramp-file-name-localname x)))
(tramp-list-connections))) (tramp-list-connections)))
name) name)

View file

@ -145,7 +145,7 @@ pass to the OPERATION."
((memq operation '(file-directory-p file-exists-p)) ((memq operation '(file-directory-p file-exists-p))
(if (apply 'ange-ftp-hook-function operation args) (if (apply 'ange-ftp-hook-function operation args)
(let ((v (tramp-dissect-file-name (car args) t))) (let ((v (tramp-dissect-file-name (car args) t)))
(aset v 0 tramp-ftp-method) (setf (tramp-file-name-method v) tramp-ftp-method)
(tramp-set-connection-property v "started" t)) (tramp-set-connection-property v "started" t))
nil)) nil))

View file

@ -807,7 +807,8 @@ file names."
;; If there is a default location, expand tilde. ;; If there is a default location, expand tilde.
(when (string-match "\\`\\(~\\)\\(/\\|\\'\\)" localname) (when (string-match "\\`\\(~\\)\\(/\\|\\'\\)" localname)
(save-match-data (save-match-data
(tramp-gvfs-maybe-open-connection (vector method user host "/" hop))) (tramp-gvfs-maybe-open-connection
(tramp-make-tramp-file-name method user domain host port "/" hop)))
(setq localname (setq localname
(replace-match (replace-match
(tramp-get-connection-property v "default-location" "~") (tramp-get-connection-property v "default-location" "~")
@ -831,7 +832,7 @@ file names."
;; No tilde characters in file name, do normal ;; No tilde characters in file name, do normal
;; `expand-file-name' (this does "/./" and "/../"). ;; `expand-file-name' (this does "/./" and "/../").
(tramp-make-tramp-file-name (tramp-make-tramp-file-name
method user host method user domain host port
(tramp-run-real-handler (tramp-run-real-handler
'expand-file-name (list localname)))))) 'expand-file-name (list localname))))))
@ -1249,7 +1250,7 @@ file-notify events."
(concat (match-string 2 user) ";" (match-string 1 user)))) (concat (match-string 2 user) ";" (match-string 1 user))))
(url-parse-make-urlobj (url-parse-make-urlobj
method (and user (url-hexify-string user)) nil method (and user (url-hexify-string user)) nil
(tramp-file-name-real-host v) (tramp-file-name-port v) (tramp-file-name-host v) (tramp-file-name-port v)
(and localname (url-hexify-string localname)) nil nil t)) (and localname (url-hexify-string localname)) nil nil t))
(url-parse-make-urlobj (url-parse-make-urlobj
"file" nil nil nil nil "file" nil nil nil nil
@ -1329,12 +1330,12 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
t ;; password handled. t ;; password handled.
nil ;; no abort of D-Bus. nil ;; no abort of D-Bus.
password password
(tramp-file-name-real-user l) (tramp-file-name-user l)
domain domain
nil ;; not anonymous. nil ;; not anonymous.
0) ;; no password save. 0) ;; no password save.
;; No password provided. ;; No password provided.
(list nil t "" (tramp-file-name-real-user l) domain nil 0))) (list nil t "" (tramp-file-name-user l) domain nil 0)))
;; When QUIT is raised, we shall return this information to D-Bus. ;; When QUIT is raised, we shall return this information to D-Bus.
(quit (list nil t "" "" "" nil 0))))) (quit (list nil t "" "" "" nil 0)))))
@ -1420,7 +1421,7 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
(unless (zerop (length port)) (unless (zerop (length port))
(setq host (concat host tramp-prefix-port-format port))) (setq host (concat host tramp-prefix-port-format port)))
(with-parsed-tramp-file-name (with-parsed-tramp-file-name
(tramp-make-tramp-file-name method user host "") nil (tramp-make-tramp-file-name method user domain host port "") nil
(tramp-message (tramp-message
v 6 "%s %s" v 6 "%s %s"
signal-name (tramp-gvfs-stringify-dbus-message mount-info)) signal-name (tramp-gvfs-stringify-dbus-message mount-info))
@ -1533,9 +1534,9 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
(defun tramp-gvfs-mount-spec (vec) (defun tramp-gvfs-mount-spec (vec)
"Return a mount-spec for \"org.gtk.vfs.MountTracker.mountLocation\"." "Return a mount-spec for \"org.gtk.vfs.MountTracker.mountLocation\"."
(let* ((method (tramp-file-name-method vec)) (let* ((method (tramp-file-name-method vec))
(user (tramp-file-name-real-user vec)) (user (tramp-file-name-user vec))
(domain (tramp-file-name-domain vec)) (domain (tramp-file-name-domain vec))
(host (tramp-file-name-real-host vec)) (host (tramp-file-name-host vec))
(port (tramp-file-name-port vec)) (port (tramp-file-name-port vec))
(localname (tramp-file-name-unquote-localname vec)) (localname (tramp-file-name-unquote-localname vec))
(share (when (string-match "^/?\\([^/]+\\)" localname) (share (when (string-match "^/?\\([^/]+\\)" localname)
@ -1591,7 +1592,9 @@ ID-FORMAT valid values are `string' and `integer'."
(with-tramp-connection-property vec (format "uid-%s" id-format) (with-tramp-connection-property vec (format "uid-%s" id-format)
(let ((method (tramp-file-name-method vec)) (let ((method (tramp-file-name-method vec))
(user (tramp-file-name-user vec)) (user (tramp-file-name-user vec))
(domain (tramp-file-name-domain vec))
(host (tramp-file-name-host vec)) (host (tramp-file-name-host vec))
(port (tramp-file-name-port vec))
(localname (localname
(tramp-get-connection-property vec "default-location" nil))) (tramp-get-connection-property vec "default-location" nil)))
(cond (cond
@ -1599,7 +1602,8 @@ ID-FORMAT valid values are `string' and `integer'."
(localname (localname
(tramp-compat-file-attribute-user-id (tramp-compat-file-attribute-user-id
(file-attributes (file-attributes
(tramp-make-tramp-file-name method user host localname) id-format))) (tramp-make-tramp-file-name method user domain host port localname)
id-format)))
((equal id-format 'integer) tramp-unknown-id-integer) ((equal id-format 'integer) tramp-unknown-id-integer)
((equal id-format 'string) tramp-unknown-id-string))))) ((equal id-format 'string) tramp-unknown-id-string)))))
@ -1609,14 +1613,17 @@ ID-FORMAT valid values are `string' and `integer'."
(with-tramp-connection-property vec (format "gid-%s" id-format) (with-tramp-connection-property vec (format "gid-%s" id-format)
(let ((method (tramp-file-name-method vec)) (let ((method (tramp-file-name-method vec))
(user (tramp-file-name-user vec)) (user (tramp-file-name-user vec))
(domain (tramp-file-name-domain vec))
(host (tramp-file-name-host vec)) (host (tramp-file-name-host vec))
(port (tramp-file-name-port vec))
(localname (localname
(tramp-get-connection-property vec "default-location" nil))) (tramp-get-connection-property vec "default-location" nil)))
(cond (cond
(localname (localname
(tramp-compat-file-attribute-group-id (tramp-compat-file-attribute-group-id
(file-attributes (file-attributes
(tramp-make-tramp-file-name method user host localname) id-format))) (tramp-make-tramp-file-name method user domain host port localname)
id-format)))
((equal id-format 'integer) tramp-unknown-id-integer) ((equal id-format 'integer) tramp-unknown-id-integer)
((equal id-format 'string) tramp-unknown-id-string))))) ((equal id-format 'string) tramp-unknown-id-string)))))
@ -1644,11 +1651,13 @@ connection if a previous connection has died for some reason."
(unless (tramp-gvfs-connection-mounted-p vec) (unless (tramp-gvfs-connection-mounted-p vec)
(let* ((method (tramp-file-name-method vec)) (let* ((method (tramp-file-name-method vec))
(user (tramp-file-name-user vec)) (user (tramp-file-name-user vec))
(domain (tramp-file-name-domain vec))
(host (tramp-file-name-host vec)) (host (tramp-file-name-host vec))
(port (tramp-file-name-port vec))
(localname (tramp-file-name-unquote-localname vec)) (localname (tramp-file-name-unquote-localname vec))
(object-path (object-path
(tramp-gvfs-object-path (tramp-gvfs-object-path
(tramp-make-tramp-file-name method user host "")))) (tramp-make-tramp-file-name method user domain host port ""))))
(when (and (string-equal method "afp") (when (and (string-equal method "afp")
(string-equal localname "/")) (string-equal localname "/"))

View file

@ -1122,7 +1122,7 @@ target of the symlink differ."
"%s%s" "%s%s"
(with-parsed-tramp-file-name (expand-file-name filename) nil (with-parsed-tramp-file-name (expand-file-name filename) nil
(tramp-make-tramp-file-name (tramp-make-tramp-file-name
method user host method user domain host port
(with-tramp-file-property v localname "file-truename" (with-tramp-file-property v localname "file-truename"
(let ((result nil) ; result steps in reverse order (let ((result nil) ; result steps in reverse order
(quoted (tramp-compat-file-name-quoted-p localname)) (quoted (tramp-compat-file-name-quoted-p localname))
@ -1174,7 +1174,7 @@ target of the symlink differ."
(tramp-compat-file-attribute-type (tramp-compat-file-attribute-type
(file-attributes (file-attributes
(tramp-make-tramp-file-name (tramp-make-tramp-file-name
method user host method user domain host port
(mapconcat 'identity (mapconcat 'identity
(append '("") (append '("")
(reverse result) (reverse result)
@ -2335,7 +2335,7 @@ The method used must be an out-of-band method."
(let* ((t1 (tramp-tramp-file-p filename)) (let* ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname)) (t2 (tramp-tramp-file-p newname))
(orig-vec (tramp-dissect-file-name (if t1 filename newname))) (orig-vec (tramp-dissect-file-name (if t1 filename newname)))
copy-program copy-args copy-env copy-keep-date port listener spec copy-program copy-args copy-env copy-keep-date listener spec
options source target remote-copy-program remote-copy-args) options source target remote-copy-program remote-copy-args)
(with-parsed-tramp-file-name (if t1 filename newname) nil (with-parsed-tramp-file-name (if t1 filename newname) nil
@ -2368,7 +2368,7 @@ The method used must be an out-of-band method."
tramp-current-user (or (tramp-file-name-user v) tramp-current-user (or (tramp-file-name-user v)
(tramp-get-connection-property (tramp-get-connection-property
v "login-as" nil)) v "login-as" nil))
tramp-current-host (tramp-file-name-real-host v)) tramp-current-host (tramp-file-name-host v))
;; Check which ones of source and target are Tramp files. ;; Check which ones of source and target are Tramp files.
(setq source (funcall (setq source (funcall
@ -2383,10 +2383,6 @@ The method used must be an out-of-band method."
(tramp-make-copy-program-file-name v) (tramp-make-copy-program-file-name v)
(tramp-unquote-shell-quote-argument newname))) (tramp-unquote-shell-quote-argument newname)))
;; Check for host and port number.
(setq host (tramp-file-name-real-host v)
port (tramp-file-name-port v))
;; Check for user. There might be an interactive setting. ;; Check for user. There might be an interactive setting.
(setq user (or (tramp-file-name-user v) (setq user (or (tramp-file-name-user v)
(tramp-get-connection-property v "login-as" nil))) (tramp-get-connection-property v "login-as" nil)))
@ -2809,7 +2805,7 @@ the result will be a local, non-Tramp, file name."
;; be problems with UNC shares or Cygwin mounts. ;; be problems with UNC shares or Cygwin mounts.
(let ((default-directory (tramp-compat-temporary-file-directory))) (let ((default-directory (tramp-compat-temporary-file-directory)))
(tramp-make-tramp-file-name (tramp-make-tramp-file-name
method user host method user domain host port
(tramp-drop-volume-letter (tramp-drop-volume-letter
(tramp-run-real-handler (tramp-run-real-handler
'expand-file-name (list localname))) 'expand-file-name (list localname)))
@ -2861,7 +2857,9 @@ the result will be a local, non-Tramp, file name."
(tramp-make-tramp-file-name (tramp-make-tramp-file-name
(tramp-file-name-method v) (tramp-file-name-method v)
(tramp-file-name-user v) (tramp-file-name-user v)
(tramp-file-name-domain v)
(tramp-file-name-host v) (tramp-file-name-host v)
(tramp-file-name-port v)
(tramp-file-name-localname v)) (tramp-file-name-localname v))
tramp-initial-end-of-output)) tramp-initial-end-of-output))
;; We use as environment the difference to toplevel ;; We use as environment the difference to toplevel
@ -2999,7 +2997,8 @@ the result will be a local, non-Tramp, file name."
(setq input (with-parsed-tramp-file-name infile nil localname)) (setq input (with-parsed-tramp-file-name infile nil localname))
;; INFILE must be copied to remote host. ;; INFILE must be copied to remote host.
(setq input (tramp-make-tramp-temp-file v) (setq input (tramp-make-tramp-temp-file v)
tmpinput (tramp-make-tramp-file-name method user host input)) tmpinput
(tramp-make-tramp-file-name method user domain host port input))
(copy-file infile tmpinput t))) (copy-file infile tmpinput t)))
(when input (setq command (format "%s <%s" command input))) (when input (setq command (format "%s <%s" command input)))
@ -3033,7 +3032,7 @@ the result will be a local, non-Tramp, file name."
;; file must be deleted after execution. ;; file must be deleted after execution.
(setq stderr (tramp-make-tramp-temp-file v) (setq stderr (tramp-make-tramp-temp-file v)
tmpstderr (tramp-make-tramp-file-name tmpstderr (tramp-make-tramp-file-name
method user host stderr)))) method user domain host port stderr))))
;; stderr to be discarded. ;; stderr to be discarded.
((null (cadr destination)) ((null (cadr destination))
(setq stderr "/dev/null")))) (setq stderr "/dev/null"))))
@ -4546,7 +4545,7 @@ Goes through the list `tramp-inline-compress-commands'."
;; host name. ;; host name.
(let* ((v (car target-alist)) (let* ((v (car target-alist))
(method (tramp-file-name-method v)) (method (tramp-file-name-method v))
(host (tramp-file-name-real-host v))) (host (tramp-file-name-host v)))
(unless (unless
(or (or
;; There are multi-hops. ;; There are multi-hops.
@ -4623,8 +4622,8 @@ connection if a previous connection has died for some reason."
;; If Tramp opens the same connection within a short time frame, ;; If Tramp opens the same connection within a short time frame,
;; there is a problem. We shall signal this. ;; there is a problem. We shall signal this.
(unless (or (tramp-compat-process-live-p p) (unless (or (tramp-compat-process-live-p p)
(not (equal (butlast (append vec nil) 2) (not (tramp-file-name-equal-p
(car tramp-current-connection))) vec (car tramp-current-connection)))
(> (tramp-time-diff (> (tramp-time-diff
(current-time) (cdr tramp-current-connection)) (current-time) (cdr tramp-current-connection))
(or tramp-connection-min-time-diff 0))) (or tramp-connection-min-time-diff 0)))
@ -4721,8 +4720,7 @@ connection if a previous connection has died for some reason."
(set-process-sentinel p 'tramp-process-sentinel) (set-process-sentinel p 'tramp-process-sentinel)
(process-put p 'adjust-window-size-function 'ignore) (process-put p 'adjust-window-size-function 'ignore)
(set-process-query-on-exit-flag p nil) (set-process-query-on-exit-flag p nil)
(setq tramp-current-connection (setq tramp-current-connection (cons vec (current-time))
(cons (butlast (append vec nil) 2) (current-time))
tramp-current-host (system-name)) tramp-current-host (system-name))
(tramp-message (tramp-message
@ -5104,7 +5102,7 @@ Return ATTR."
"Create a file name suitable for `scp', `pscp', or `nc' and workalikes." "Create a file name suitable for `scp', `pscp', or `nc' and workalikes."
(let ((method (tramp-file-name-method vec)) (let ((method (tramp-file-name-method vec))
(user (tramp-file-name-user vec)) (user (tramp-file-name-user vec))
(host (tramp-file-name-real-host vec)) (host (tramp-file-name-host vec))
(localname (localname
(directory-file-name (tramp-file-name-unquote-localname vec)))) (directory-file-name (tramp-file-name-unquote-localname vec))))
(when (string-match tramp-ipv6-regexp host) (when (string-match tramp-ipv6-regexp host)
@ -5218,7 +5216,9 @@ Nonexistent directories are removed from spec."
(tramp-make-tramp-file-name (tramp-make-tramp-file-name
(tramp-file-name-method vec) (tramp-file-name-method vec)
(tramp-file-name-user vec) (tramp-file-name-user vec)
(tramp-file-name-domain vec)
(tramp-file-name-host vec) (tramp-file-name-host vec)
(tramp-file-name-port vec)
x)) x))
x)) x))
remote-path))))) remote-path)))))
@ -5636,14 +5636,14 @@ function cell is returned to be applied on a buffer."
(let ((coding-system-for-write 'binary) (let ((coding-system-for-write 'binary)
(coding-system-for-read 'binary)) (coding-system-for-read 'binary))
(apply (apply
'tramp-call-process-region ,vec (point-min) (point-max) 'tramp-call-process-region ',vec (point-min) (point-max)
(car (split-string ,compress)) t t nil (car (split-string ,compress)) t t nil
(cdr (split-string ,compress))))) (cdr (split-string ,compress)))))
`(lambda (beg end) `(lambda (beg end)
(let ((coding-system-for-write 'binary) (let ((coding-system-for-write 'binary)
(coding-system-for-read 'binary)) (coding-system-for-read 'binary))
(apply (apply
'tramp-call-process-region ,vec beg end 'tramp-call-process-region ',vec beg end
(car (split-string ,compress)) t t nil (car (split-string ,compress)) t t nil
(cdr (split-string ,compress)))) (cdr (split-string ,compress))))
(,coding (point-min) (point-max))))) (,coding (point-min) (point-max)))))

View file

@ -53,12 +53,6 @@
;; Another guess. We might implement a better check later on. ;; Another guess. We might implement a better check later on.
(tramp-case-insensitive t)))) (tramp-case-insensitive t))))
;; Add a default for `tramp-default-method-alist'. Rule: If there is
;; a domain in USER, it must be the SMB method.
;;;###tramp-autoload
(add-to-list 'tramp-default-method-alist
`(nil ,tramp-prefix-domain-regexp ,tramp-smb-method))
;; Add a default for `tramp-default-user-alist'. Rule: For the SMB method, ;; Add a default for `tramp-default-user-alist'. Rule: For the SMB method,
;; the anonymous user is chosen. ;; the anonymous user is chosen.
;;;###tramp-autoload ;;;###tramp-autoload
@ -449,15 +443,11 @@ pass to the OPERATION."
(if (not (file-directory-p newname)) (if (not (file-directory-p newname))
(make-directory newname parents)) (make-directory newname parents))
(setq tramp-current-method (tramp-file-name-method v) (setq tramp-current-method method
tramp-current-user (tramp-file-name-user v) tramp-current-user user
tramp-current-host (tramp-file-name-real-host v)) tramp-current-host host)
(let* ((real-user (tramp-file-name-real-user v)) (let* ((share (tramp-smb-get-share v))
(real-host (tramp-file-name-real-host v))
(domain (tramp-file-name-domain v))
(port (tramp-file-name-port v))
(share (tramp-smb-get-share v))
(localname (file-name-as-directory (localname (file-name-as-directory
(replace-regexp-in-string (replace-regexp-in-string
"\\\\" "/" (tramp-smb-get-localname v)))) "\\\\" "/" (tramp-smb-get-localname v))))
@ -465,10 +455,10 @@ pass to the OPERATION."
(expand-file-name (expand-file-name
tramp-temp-name-prefix tramp-temp-name-prefix
(tramp-compat-temporary-file-directory)))) (tramp-compat-temporary-file-directory))))
(args (list (concat "//" real-host "/" share) "-E"))) (args (list (concat "//" host "/" share) "-E")))
(if (not (zerop (length real-user))) (if (not (zerop (length user)))
(setq args (append args (list "-U" real-user))) (setq args (append args (list "-U" user)))
(setq args (append args (list "-N")))) (setq args (append args (list "-N"))))
(when domain (setq args (append args (list "-W" domain)))) (when domain (setq args (append args (list "-W" domain))))
@ -708,7 +698,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setq localname (setq localname
(replace-match (replace-match
(if (zerop (length (match-string 1 localname))) (if (zerop (length (match-string 1 localname)))
(tramp-file-name-real-user v) user
(match-string 1 localname)) (match-string 1 localname))
nil nil localname))) nil nil localname)))
;; Make the file name absolute. ;; Make the file name absolute.
@ -717,7 +707,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; No tilde characters in file name, do normal ;; No tilde characters in file name, do normal
;; `expand-file-name' (this does "/./" and "/../"). ;; `expand-file-name' (this does "/./" and "/../").
(tramp-make-tramp-file-name (tramp-make-tramp-file-name
method user host method user domain host port
(tramp-run-real-handler 'expand-file-name (list localname)))))) (tramp-run-real-handler 'expand-file-name (list localname))))))
(defun tramp-smb-action-get-acl (proc vec) (defun tramp-smb-action-get-acl (proc vec)
@ -744,21 +734,17 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(with-tramp-file-property v localname "file-acl" (with-tramp-file-property v localname "file-acl"
(when (executable-find tramp-smb-acl-program) (when (executable-find tramp-smb-acl-program)
(setq tramp-current-method (tramp-file-name-method v) (setq tramp-current-method method
tramp-current-user (tramp-file-name-user v) tramp-current-user user
tramp-current-host (tramp-file-name-real-host v)) tramp-current-host host)
(let* ((real-user (tramp-file-name-real-user v)) (let* ((share (tramp-smb-get-share v))
(real-host (tramp-file-name-real-host v))
(domain (tramp-file-name-domain v))
(port (tramp-file-name-port v))
(share (tramp-smb-get-share v))
(localname (replace-regexp-in-string (localname (replace-regexp-in-string
"\\\\" "/" (tramp-smb-get-localname v))) "\\\\" "/" (tramp-smb-get-localname v)))
(args (list (concat "//" real-host "/" share) "-E"))) (args (list (concat "//" host "/" share) "-E")))
(if (not (zerop (length real-user))) (if (not (zerop (length user)))
(setq args (append args (list "-U" real-user))) (setq args (append args (list "-U" user)))
(setq args (append args (list "-N")))) (setq args (append args (list "-N"))))
(when domain (setq args (append args (list "-W" domain)))) (when domain (setq args (append args (list "-W" domain))))
@ -1179,7 +1165,8 @@ target of the symlink differ."
(setq input (with-parsed-tramp-file-name infile nil localname)) (setq input (with-parsed-tramp-file-name infile nil localname))
;; INFILE must be copied to remote host. ;; INFILE must be copied to remote host.
(setq input (tramp-make-tramp-temp-file v) (setq input (tramp-make-tramp-temp-file v)
tmpinput (tramp-make-tramp-file-name method user host input)) tmpinput
(tramp-make-tramp-file-name method user domain host port input))
(copy-file infile tmpinput t)) (copy-file infile tmpinput t))
;; Transform input into a filename powershell does understand. ;; Transform input into a filename powershell does understand.
(setq input (format "//%s%s" host input))) (setq input (format "//%s%s" host input)))
@ -1337,24 +1324,20 @@ target of the symlink differ."
(ignore-errors (ignore-errors
(with-parsed-tramp-file-name filename nil (with-parsed-tramp-file-name filename nil
(when (and (stringp acl-string) (executable-find tramp-smb-acl-program)) (when (and (stringp acl-string) (executable-find tramp-smb-acl-program))
(setq tramp-current-method (tramp-file-name-method v) (setq tramp-current-method method
tramp-current-user (tramp-file-name-user v) tramp-current-user user
tramp-current-host (tramp-file-name-real-host v)) tramp-current-host host)
(tramp-set-file-property v localname "file-acl" 'undef) (tramp-set-file-property v localname "file-acl" 'undef)
(let* ((real-user (tramp-file-name-real-user v)) (let* ((share (tramp-smb-get-share v))
(real-host (tramp-file-name-real-host v))
(domain (tramp-file-name-domain v))
(port (tramp-file-name-port v))
(share (tramp-smb-get-share v))
(localname (replace-regexp-in-string (localname (replace-regexp-in-string
"\\\\" "/" (tramp-smb-get-localname v))) "\\\\" "/" (tramp-smb-get-localname v)))
(args (list (concat "//" real-host "/" share) "-E" "-S" (args (list (concat "//" host "/" share) "-E" "-S"
(replace-regexp-in-string (replace-regexp-in-string
"\n" "," acl-string)))) "\n" "," acl-string))))
(if (not (zerop (length real-user))) (if (not (zerop (length user)))
(setq args (append args (list "-U" real-user))) (setq args (append args (list "-U" user)))
(setq args (append args (list "-N")))) (setq args (append args (list "-N"))))
(when domain (setq args (append args (list "-W" domain)))) (when domain (setq args (append args (list "-W" domain))))
@ -1847,22 +1830,20 @@ If ARGUMENT is non-nil, use it as argument for
(let* ((user (tramp-file-name-user vec)) (let* ((user (tramp-file-name-user vec))
(host (tramp-file-name-host vec)) (host (tramp-file-name-host vec))
(real-user (tramp-file-name-real-user vec))
(real-host (tramp-file-name-real-host vec))
(domain (tramp-file-name-domain vec)) (domain (tramp-file-name-domain vec))
(port (tramp-file-name-port vec)) (port (tramp-file-name-port vec))
args) args)
(cond (cond
(argument (argument
(setq args (list (concat "//" real-host)))) (setq args (list (concat "//" host))))
(share (share
(setq args (list (concat "//" real-host "/" share)))) (setq args (list (concat "//" host "/" share))))
(t (t
(setq args (list "-g" "-L" real-host )))) (setq args (list "-g" "-L" host ))))
(if (not (zerop (length real-user))) (if (not (zerop (length user)))
(setq args (append args (list "-U" real-user))) (setq args (append args (list "-U" user)))
(setq args (append args (list "-N")))) (setq args (append args (list "-N"))))
(when domain (setq args (append args (list "-W" domain)))) (when domain (setq args (append args (list "-W" domain))))

View file

@ -1099,9 +1099,15 @@ means to use always cached values for the directory contents."
(defvar tramp-current-user nil (defvar tramp-current-user nil
"Remote login name for this *tramp* buffer.") "Remote login name for this *tramp* buffer.")
(defvar tramp-current-domain nil
"Remote domain name for this *tramp* buffer.")
(defvar tramp-current-host nil (defvar tramp-current-host nil
"Remote host for this *tramp* buffer.") "Remote host for this *tramp* buffer.")
(defvar tramp-current-port nil
"Remote port for this *tramp* buffer.")
(defvar tramp-current-connection nil (defvar tramp-current-connection nil
"Last connection timestamp.") "Last connection timestamp.")
@ -1128,6 +1134,37 @@ calling HANDLER.")
;; internal data structure. Convenience functions for internal ;; internal data structure. Convenience functions for internal
;; data structure. ;; data structure.
;; The basic structure for remote file names. We use a list,
;; otherwise the test in `tramp-cache-data' fails.
(cl-defstruct (tramp-file-name (:type list) :named)
method user domain host port localname hop)
(defun tramp-file-name-user-domain (vec)
"Return user and domain components of VEC."
(when (or (tramp-file-name-user vec) (tramp-file-name-domain vec))
(concat (tramp-file-name-user vec)
(and (tramp-file-name-domain vec)
tramp-prefix-domain-format)
(tramp-file-name-domain vec))))
(defun tramp-file-name-host-port (vec)
"Return host and port components of VEC."
(when (or (tramp-file-name-host vec) (tramp-file-name-port vec))
(concat (tramp-file-name-host vec)
(and (tramp-file-name-port vec)
tramp-prefix-port-format)
(tramp-file-name-port vec))))
(defun tramp-file-name-equal-p (vec1 vec2)
"Check, whether VEC1 and VEC2 denote the same `tramp-file-name'."
(and (tramp-file-name-p vec1) (tramp-file-name-p vec2)
(string-equal (tramp-file-name-method vec1)
(tramp-file-name-method vec2))
(string-equal (tramp-file-name-user-domain vec1)
(tramp-file-name-user-domain vec2))
(string-equal (tramp-file-name-host-port vec1)
(tramp-file-name-host-port vec2))))
(defun tramp-get-method-parameter (vec param) (defun tramp-get-method-parameter (vec param)
"Return the method parameter PARAM. "Return the method parameter PARAM.
If VEC is a vector, check first in connection properties. If VEC is a vector, check first in connection properties.
@ -1143,69 +1180,6 @@ entry does not exist, return nil."
(assoc param (assoc (tramp-file-name-method vec) tramp-methods)))) (assoc param (assoc (tramp-file-name-method vec) tramp-methods))))
(when methods-entry (cadr methods-entry)))))) (when methods-entry (cadr methods-entry))))))
(defun tramp-file-name-p (vec)
"Check, whether VEC is a Tramp object."
(and (vectorp vec) (= 5 (length vec))))
(defun tramp-file-name-method (vec)
"Return method component of VEC."
(and (tramp-file-name-p vec) (aref vec 0)))
(defun tramp-file-name-user (vec)
"Return user component of VEC."
(and (tramp-file-name-p vec) (aref vec 1)))
(defun tramp-file-name-host (vec)
"Return host component of VEC."
(and (tramp-file-name-p vec) (aref vec 2)))
(defun tramp-file-name-localname (vec)
"Return localname component of VEC."
(and (tramp-file-name-p vec) (aref vec 3)))
(defun tramp-file-name-hop (vec)
"Return hop component of VEC."
(and (tramp-file-name-p vec) (aref vec 4)))
;; The user part of a Tramp file name vector can be of kind
;; "user%domain". Sometimes, we must extract these parts.
(defun tramp-file-name-real-user (vec)
"Return the user name of VEC without domain."
(save-match-data
(let ((user (tramp-file-name-user vec)))
(if (and (stringp user)
(string-match tramp-user-with-domain-regexp user))
(match-string 1 user)
user))))
(defun tramp-file-name-domain (vec)
"Return the domain name of VEC."
(save-match-data
(let ((user (tramp-file-name-user vec)))
(and (stringp user)
(string-match tramp-user-with-domain-regexp user)
(match-string 2 user)))))
;; The host part of a Tramp file name vector can be of kind
;; "host#port". Sometimes, we must extract these parts.
(defun tramp-file-name-real-host (vec)
"Return the host name of VEC without port."
(save-match-data
(let ((host (tramp-file-name-host vec)))
(if (and (stringp host)
(string-match tramp-host-with-port-regexp host))
(match-string 1 host)
host))))
(defun tramp-file-name-port (vec)
"Return the port number of VEC."
(save-match-data
(let ((host (tramp-file-name-host vec)))
(or (and (stringp host)
(string-match tramp-host-with-port-regexp host)
(string-to-number (match-string 2 host)))
(tramp-get-method-parameter vec 'tramp-default-port)))))
;; The localname can be quoted with "/:". Extract this. ;; The localname can be quoted with "/:". Extract this.
(defun tramp-file-name-unquote-localname (vec) (defun tramp-file-name-unquote-localname (vec)
"Return unquoted localname component of VEC." "Return unquoted localname component of VEC."
@ -1299,43 +1273,67 @@ values."
(user (match-string (nth 2 (tramp-file-name-structure)) name)) (user (match-string (nth 2 (tramp-file-name-structure)) name))
(host (match-string (nth 3 (tramp-file-name-structure)) name)) (host (match-string (nth 3 (tramp-file-name-structure)) name))
(localname (match-string (nth 4 (tramp-file-name-structure)) name)) (localname (match-string (nth 4 (tramp-file-name-structure)) name))
(hop (match-string (nth 5 (tramp-file-name-structure)) name))) (hop (match-string (nth 5 (tramp-file-name-structure)) name))
domain port)
(when user
(when (string-match tramp-user-with-domain-regexp user)
(setq domain (match-string 2 user)
user (match-string 1 user))))
(when host (when host
(when (string-match tramp-host-with-port-regexp host)
(setq port (match-string 2 host)
host (match-string 1 host)))
(when (string-match (tramp-prefix-ipv6-regexp) host) (when (string-match (tramp-prefix-ipv6-regexp) host)
(setq host (replace-match "" nil t host))) (setq host (replace-match "" nil t host)))
(when (string-match (tramp-postfix-ipv6-regexp) host) (when (string-match (tramp-postfix-ipv6-regexp) host)
(setq host (replace-match "" nil t host)))) (setq host (replace-match "" nil t host))))
(if nodefault
(vector method user host localname hop) (unless nodefault
(vector (setq method (tramp-find-method method user host)
(tramp-find-method method user host) user (tramp-find-user method user host)
(tramp-find-user method user host) host (tramp-find-host method user host)))
(tramp-find-host method user host)
localname hop)))))) (apply
'make-tramp-file-name
(append
(unless (zerop (length method)) `(:method ,method))
(unless (zerop (length user)) `(:user ,user))
(unless (zerop (length domain)) `(:domain ,domain))
(unless (zerop (length host)) `(:host ,host))
(unless (zerop (length port)) `(:port ,port))
`(:localname ,(or localname ""))
(unless (zerop (length hop)) `(:hop ,hop))))))))
(defun tramp-buffer-name (vec) (defun tramp-buffer-name (vec)
"A name for the connection buffer VEC." "A name for the connection buffer VEC."
(let ((method (tramp-file-name-method vec)) (let ((method (tramp-file-name-method vec))
(user (tramp-file-name-user vec)) (user-domain (tramp-file-name-user-domain vec))
(host (tramp-file-name-real-host vec))) (host-port (tramp-file-name-host-port vec)))
(if (not (zerop (length user))) (if (not (zerop (length user-domain)))
(format "*tramp/%s %s@%s*" method user host) (format "*tramp/%s %s@%s*" method user-domain host-port)
(format "*tramp/%s %s*" method host)))) (format "*tramp/%s %s*" method host-port))))
(defun tramp-make-tramp-file-name (method user host localname &optional hop) (defun tramp-make-tramp-file-name
(method user domain host port localname &optional hop)
"Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME. "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME.
When not nil, an optional HOP is prepended." When not nil, optional DOMAIN, PORT and HOP are used."
(concat (tramp-prefix-format) hop (concat (tramp-prefix-format) hop
(unless (or (zerop (length method)) (unless (or (zerop (length method))
(zerop (length (tramp-postfix-method-format)))) (zerop (length (tramp-postfix-method-format))))
(concat method (tramp-postfix-method-format))) (concat method (tramp-postfix-method-format)))
user
(unless (zerop (length domain))
(concat tramp-prefix-domain-format domain))
(unless (zerop (length user)) (unless (zerop (length user))
(concat user tramp-postfix-user-format)) tramp-postfix-user-format)
(when host (when host
(if (string-match tramp-ipv6-regexp host) (if (string-match tramp-ipv6-regexp host)
(concat (concat
(tramp-prefix-ipv6-format) host (tramp-postfix-ipv6-format)) (tramp-prefix-ipv6-format) host (tramp-postfix-ipv6-format))
host)) host))
(unless (zerop (length port))
(concat tramp-prefix-port-format port))
(tramp-postfix-host-format) (tramp-postfix-host-format)
(when localname localname))) (when localname localname)))
@ -1372,7 +1370,9 @@ necessary only. This function will be used in file name completion."
(tramp-make-tramp-file-name (tramp-make-tramp-file-name
(tramp-file-name-method vec) (tramp-file-name-method vec)
(tramp-file-name-user vec) (tramp-file-name-user vec)
(tramp-file-name-domain vec)
(tramp-file-name-host vec) (tramp-file-name-host vec)
(tramp-file-name-port vec)
"/")) "/"))
(current-buffer)))) (current-buffer))))
@ -1406,8 +1406,8 @@ version, the function does nothing."
'hack-connection-local-variables-apply 'hack-connection-local-variables-apply
`(:application tramp `(:application tramp
:protocol ,(tramp-file-name-method vec) :protocol ,(tramp-file-name-method vec)
:user ,(tramp-file-name-user vec) :user ,(tramp-file-name-user-domain vec)
:machine ,(tramp-file-name-host vec))))) :machine ,(tramp-file-name-host-port vec)))))
(defun tramp-set-connection-local-variables-for-buffer () (defun tramp-set-connection-local-variables-for-buffer ()
"Set connection-local variables in the current buffer. "Set connection-local variables in the current buffer.
@ -1425,11 +1425,11 @@ version, the function does nothing."
(defun tramp-debug-buffer-name (vec) (defun tramp-debug-buffer-name (vec)
"A name for the debug buffer for VEC." "A name for the debug buffer for VEC."
(let ((method (tramp-file-name-method vec)) (let ((method (tramp-file-name-method vec))
(user (tramp-file-name-user vec)) (user-domain (tramp-file-name-user-domain vec))
(host (tramp-file-name-real-host vec))) (host-port (tramp-file-name-host-port vec)))
(if (not (zerop (length user))) (if (not (zerop (length user-domain)))
(format "*debug tramp/%s %s@%s*" method user host) (format "*debug tramp/%s %s@%s*" method user-domain host-port)
(format "*debug tramp/%s %s*" method host)))) (format "*debug tramp/%s %s*" method host-port))))
(defconst tramp-debug-outline-regexp (defconst tramp-debug-outline-regexp
"[0-9]+:[0-9]+:[0-9]+\\.[0-9]+ [a-z0-9-]+ (\\([0-9]+\\)) #" "[0-9]+:[0-9]+:[0-9]+\\.[0-9]+ [a-z0-9-]+ (\\([0-9]+\\)) #"
@ -1576,7 +1576,7 @@ applicable)."
(setq fmt-string (concat fmt-string "\n%s") (setq fmt-string (concat fmt-string "\n%s")
arguments (append arguments (list (buffer-string))))))) arguments (append arguments (list (buffer-string)))))))
;; Do it. ;; Do it.
(when (vectorp vec-or-proc) (when (tramp-file-name-p vec-or-proc)
(apply 'tramp-debug-message (apply 'tramp-debug-message
vec-or-proc vec-or-proc
(concat (format "(%d) # " level) fmt-string) (concat (format "(%d) # " level) fmt-string)
@ -1615,9 +1615,9 @@ an input event arrives. The other arguments are passed to `tramp-error'."
(save-window-excursion (save-window-excursion
(let* ((buf (or (and (bufferp buf) buf) (let* ((buf (or (and (bufferp buf) buf)
(and (processp vec-or-proc) (process-buffer vec-or-proc)) (and (processp vec-or-proc) (process-buffer vec-or-proc))
(and (vectorp vec-or-proc) (and (tramp-file-name-p vec-or-proc)
(tramp-get-connection-buffer vec-or-proc)))) (tramp-get-connection-buffer vec-or-proc))))
(vec (or (and (vectorp vec-or-proc) vec-or-proc) (vec (or (and (tramp-file-name-p vec-or-proc) vec-or-proc)
(and buf (with-current-buffer buf (and buf (with-current-buffer buf
(tramp-dissect-file-name default-directory)))))) (tramp-dissect-file-name default-directory))))))
(unwind-protect (unwind-protect
@ -1639,8 +1639,7 @@ an input event arrives. The other arguments are passed to `tramp-error'."
(discard-input) (discard-input)
(sit-for 30))) (sit-for 30)))
;; Reset timestamp. It would be wrong after waiting for a while. ;; Reset timestamp. It would be wrong after waiting for a while.
(when (equal (butlast (append vec nil) 2) (when (tramp-file-name-equal-p vec (car tramp-current-connection))
(car tramp-current-connection))
(setcdr tramp-current-connection (current-time))))))) (setcdr tramp-current-connection (current-time)))))))
(defmacro with-parsed-tramp-file-name (filename var &rest body) (defmacro with-parsed-tramp-file-name (filename var &rest body)
@ -1664,7 +1663,7 @@ If VAR is nil, then we bind `v' to the structure and `method', `user',
`(,(if var (intern (format "%s-%s" var elem)) elem) `(,(if var (intern (format "%s-%s" var elem)) elem)
(,(intern (format "tramp-file-name-%s" elem)) (,(intern (format "tramp-file-name-%s" elem))
,(or var 'v)))) ,(or var 'v))))
'(method user host localname hop)))) '(method user domain host port localname hop))))
`(let* ((,(or var 'v) (tramp-dissect-file-name ,filename)) `(let* ((,(or var 'v) (tramp-dissect-file-name ,filename))
,@bindings) ,@bindings)
;; We don't know which of those vars will be used, so we bind them all, ;; We don't know which of those vars will be used, so we bind them all,
@ -2508,15 +2507,13 @@ remote host and localname (filename on remote host)."
(save-match-data (save-match-data
(when (string-match (nth 0 structure) name) (when (string-match (nth 0 structure) name)
(let ((method (and (nth 1 structure) (make-tramp-file-name
(match-string (nth 1 structure) name))) :method (and (nth 1 structure)
(user (and (nth 2 structure) (match-string (nth 1 structure) name))
(match-string (nth 2 structure) name))) :user (and (nth 2 structure)
(host (and (nth 3 structure) (match-string (nth 2 structure) name))
(match-string (nth 3 structure) name))) :host (and (nth 3 structure)
(localname (and (nth 4 structure) (match-string (nth 3 structure) name))))))
(match-string (nth 4 structure) name))))
(vector method user host localname nil)))))
;; This function returns all possible method completions, adding the ;; This function returns all possible method completions, adding the
;; trailing method delimiter. ;; trailing method delimiter.
@ -2862,7 +2859,9 @@ User is always nil."
(tramp-make-tramp-file-name (tramp-make-tramp-file-name
(tramp-file-name-method v) (tramp-file-name-method v)
(tramp-file-name-user v) (tramp-file-name-user v)
(tramp-file-name-domain v)
(tramp-file-name-host v) (tramp-file-name-host v)
(tramp-file-name-port v)
(if (and (zerop (length (tramp-file-name-localname v))) (if (and (zerop (length (tramp-file-name-localname v)))
(not (tramp-connectable-p file))) (not (tramp-connectable-p file)))
"" ""
@ -2951,7 +2950,9 @@ User is always nil."
(tramp-make-tramp-file-name (tramp-make-tramp-file-name
(tramp-file-name-method v) (tramp-file-name-method v)
(tramp-file-name-user v) (tramp-file-name-user v)
(tramp-file-name-domain v)
(tramp-file-name-host v) (tramp-file-name-host v)
(tramp-file-name-port v)
(tramp-run-real-handler (tramp-run-real-handler
'file-name-directory (list (or (tramp-file-name-localname v) ""))) 'file-name-directory (list (or (tramp-file-name-localname v) "")))
(tramp-file-name-hop v)))) (tramp-file-name-hop v))))
@ -2993,11 +2994,13 @@ User is always nil."
(and (or (not connected) c) (and (or (not connected) c)
(cond (cond
((eq identification 'method) method) ((eq identification 'method) method)
((eq identification 'user) user) ;; Domain and port are appended.
((eq identification 'host) host) ((eq identification 'user) (tramp-file-name-user-domain v))
((eq identification 'host) (tramp-file-name-host-port v))
((eq identification 'localname) localname) ((eq identification 'localname) localname)
((eq identification 'hop) hop) ((eq identification 'hop) hop)
(t (tramp-make-tramp-file-name method user host "" hop))))))))) (t (tramp-make-tramp-file-name
method user domain host port "" hop)))))))))
(defun tramp-handle-file-symlink-p (filename) (defun tramp-handle-file-symlink-p (filename)
"Like `file-symlink-p' for Tramp files." "Like `file-symlink-p' for Tramp files."
@ -3005,7 +3008,7 @@ User is always nil."
(let ((x (tramp-compat-file-attribute-type (file-attributes filename)))) (let ((x (tramp-compat-file-attribute-type (file-attributes filename))))
(when (stringp x) (when (stringp x)
(if (file-name-absolute-p x) (if (file-name-absolute-p x)
(tramp-make-tramp-file-name method user host x) (tramp-make-tramp-file-name method user domain host port x)
x))))) x)))))
(defun tramp-handle-find-backup-file-name (filename) (defun tramp-handle-find-backup-file-name (filename)
@ -3020,7 +3023,8 @@ User is always nil."
(if (and (stringp (cdr x)) (if (and (stringp (cdr x))
(file-name-absolute-p (cdr x)) (file-name-absolute-p (cdr x))
(not (tramp-file-name-p (cdr x)))) (not (tramp-file-name-p (cdr x))))
(tramp-make-tramp-file-name method user host (cdr x)) (tramp-make-tramp-file-name
method user domain host port (cdr x))
(cdr x)))) (cdr x))))
tramp-backup-directory-alist) tramp-backup-directory-alist)
backup-directory-alist))) backup-directory-alist)))
@ -3125,7 +3129,7 @@ User is always nil."
((stringp remote-copy) ((stringp remote-copy)
(file-local-copy (file-local-copy
(tramp-make-tramp-file-name (tramp-make-tramp-file-name
method user host remote-copy))) method user domain host port remote-copy)))
((stringp tramp-temp-buffer-file-name) ((stringp tramp-temp-buffer-file-name)
(copy-file (copy-file
filename tramp-temp-buffer-file-name 'ok) filename tramp-temp-buffer-file-name 'ok)
@ -3170,7 +3174,8 @@ User is always nil."
(delete-file local-copy)) (delete-file local-copy))
(when (stringp remote-copy) (when (stringp remote-copy)
(delete-file (delete-file
(tramp-make-tramp-file-name method user host remote-copy))))) (tramp-make-tramp-file-name
method user domain host port remote-copy)))))
;; Result. ;; Result.
(list (expand-file-name filename) (list (expand-file-name filename)
@ -3548,7 +3553,8 @@ connection buffer."
(tramp-set-connection-property (tramp-set-connection-property
(tramp-dissect-file-name (tramp-dissect-file-name
(tramp-make-tramp-file-name (tramp-make-tramp-file-name
tramp-current-method tramp-current-user tramp-current-host "")) tramp-current-method tramp-current-user tramp-current-domain
tramp-current-host tramp-current-port ""))
"first-password-request" t) "first-password-request" t)
(save-restriction (save-restriction
(with-tramp-progress-reporter (with-tramp-progress-reporter
@ -3933,7 +3939,9 @@ be granted."
(tramp-make-tramp-file-name (tramp-make-tramp-file-name
(tramp-file-name-method vec) (tramp-file-name-method vec)
(tramp-file-name-user vec) (tramp-file-name-user vec)
(tramp-file-name-domain vec)
(tramp-file-name-host vec) (tramp-file-name-host vec)
(tramp-file-name-port vec)
(tramp-file-name-localname vec) (tramp-file-name-localname vec)
(tramp-file-name-hop vec)) (tramp-file-name-hop vec))
(intern suffix)))) (intern suffix))))
@ -3979,12 +3987,13 @@ be granted."
;;;###tramp-autoload ;;;###tramp-autoload
(defun tramp-local-host-p (vec) (defun tramp-local-host-p (vec)
"Return t if this points to the local host, nil otherwise." "Return t if this points to the local host, nil otherwise."
;; We cannot use `tramp-file-name-real-host'. A port is an (let ((host (tramp-file-name-host vec))
;; indication for an ssh tunnel or alike. (port (tramp-file-name-port vec)))
(let ((host (tramp-file-name-host vec)))
(and (and
(stringp host) (stringp host)
(string-match tramp-local-host-regexp host) (string-match tramp-local-host-regexp host)
;; A port is an indication for an ssh tunnel or alike.
(null port)
;; The method shall be applied to one of the shell file name ;; The method shall be applied to one of the shell file name
;; handlers. `tramp-local-host-p' is also called for "smb" and ;; handlers. `tramp-local-host-p' is also called for "smb" and
;; alike, where it must fail. ;; alike, where it must fail.
@ -3994,7 +4003,8 @@ be granted."
(tramp-make-tramp-file-name (tramp-make-tramp-file-name
(tramp-file-name-method vec) (tramp-file-name-method vec)
(tramp-file-name-user vec) (tramp-file-name-user vec)
host (tramp-file-name-domain vec)
host port
(tramp-compat-temporary-file-directory))) (tramp-compat-temporary-file-directory)))
;; On some systems, chown runs only for root. ;; On some systems, chown runs only for root.
(or (zerop (user-uid)) (or (zerop (user-uid))
@ -4008,7 +4018,9 @@ be granted."
(let ((dir (tramp-make-tramp-file-name (let ((dir (tramp-make-tramp-file-name
(tramp-file-name-method vec) (tramp-file-name-method vec)
(tramp-file-name-user vec) (tramp-file-name-user vec)
(tramp-file-name-domain vec)
(tramp-file-name-host vec) (tramp-file-name-host vec)
(tramp-file-name-port vec)
(or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp") (or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp")
(tramp-file-name-hop vec)))) (tramp-file-name-hop vec))))
(or (and (file-directory-p dir) (file-writable-p dir) (or (and (file-directory-p dir) (file-writable-p dir)
@ -4124,8 +4136,9 @@ PROGRAM is nil is trapped also, returning 1. Furthermore, traces
are written with verbosity of 6." are written with verbosity of 6."
(let ((default-directory (tramp-compat-temporary-file-directory)) (let ((default-directory (tramp-compat-temporary-file-directory))
(v (or vec (v (or vec
(vector tramp-current-method tramp-current-user (tramp-make-tramp-file-name
tramp-current-host nil nil))) tramp-current-method tramp-current-user tramp-current-domain
tramp-current-host tramp-current-port nil nil)))
(destination (if (eq destination t) (current-buffer) destination)) (destination (if (eq destination t) (current-buffer) destination))
output error result) output error result)
(tramp-message (tramp-message
@ -4159,8 +4172,9 @@ PROGRAM is nil is trapped also, returning 1. Furthermore, traces
are written with verbosity of 6." are written with verbosity of 6."
(let ((default-directory (tramp-compat-temporary-file-directory)) (let ((default-directory (tramp-compat-temporary-file-directory))
(v (or vec (v (or vec
(vector tramp-current-method tramp-current-user (tramp-make-tramp-file-name
tramp-current-host nil nil))) tramp-current-method tramp-current-user tramp-current-domain
tramp-current-host tramp-current-port nil nil)))
(buffer (if (eq buffer t) (current-buffer) buffer)) (buffer (if (eq buffer t) (current-buffer) buffer))
result) result)
(tramp-message (tramp-message
@ -4191,8 +4205,8 @@ Consults the auth-source package.
Invokes `password-read' if available, `read-passwd' else." Invokes `password-read' if available, `read-passwd' else."
(let* ((case-fold-search t) (let* ((case-fold-search t)
(key (tramp-make-tramp-file-name (key (tramp-make-tramp-file-name
tramp-current-method tramp-current-user tramp-current-method tramp-current-user tramp-current-domain
tramp-current-host "")) tramp-current-host tramp-current-port ""))
(pw-prompt (pw-prompt
(or prompt (or prompt
(with-current-buffer (process-buffer proc) (with-current-buffer (process-buffer proc)
@ -4248,7 +4262,9 @@ Invokes `password-read' if available, `read-passwd' else."
"Clear password cache for connection related to VEC." "Clear password cache for connection related to VEC."
(let ((method (tramp-file-name-method vec)) (let ((method (tramp-file-name-method vec))
(user (tramp-file-name-user vec)) (user (tramp-file-name-user vec))
(domain (tramp-file-name-domain vec))
(host (tramp-file-name-host vec)) (host (tramp-file-name-host vec))
(port (tramp-file-name-port vec))
(hop (tramp-file-name-hop vec))) (hop (tramp-file-name-hop vec)))
(when hop (when hop
;; Clear also the passwords of the hops. ;; Clear also the passwords of the hops.
@ -4266,7 +4282,8 @@ Invokes `password-read' if available, `read-passwd' else."
`(:max 1 ,(and user :user) ,user :host ,host :port ,method)) `(:max 1 ,(and user :user) ,user :host ,host :port ,method))
(tramp-compat-funcall (tramp-compat-funcall
'auth-source-forget-user-or-password "password" host method)) 'auth-source-forget-user-or-password "password" host method))
(password-cache-remove (tramp-make-tramp-file-name method user host "")))) (password-cache-remove
(tramp-make-tramp-file-name method user domain host port ""))))
;; Snarfed code from time-date.el. ;; Snarfed code from time-date.el.
@ -4393,12 +4410,6 @@ Only works for Bourne-like shells."
;; <http://www.mail-archive.com/tramp-devel@nongnu.org/msg01041.html>. ;; <http://www.mail-archive.com/tramp-devel@nongnu.org/msg01041.html>.
;; (Bug#6850) ;; (Bug#6850)
;; ;;
;; * Use also port to distinguish connections. This is needed for
;; different hosts sitting behind a single router (distinguished by
;; different port numbers). (Tzvi Edelman)
;; Also needed for different systems serve SSH on different ports of
;; the same IP address. (Bug#27009)
;;
;; * Refactor code from different handlers. Start with ;; * Refactor code from different handlers. Start with
;; *-process-file. One idea is to generalize `tramp-send-command' ;; *-process-file. One idea is to generalize `tramp-send-command'
;; and friends, for most of the handlers this is the major ;; and friends, for most of the handlers this is the major