[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master dca22e8 1/2: Introduce a defstruct `tramp-file-name
|
From: |
Michael Albinus |
|
Subject: |
[Emacs-diffs] master dca22e8 1/2: Introduce a defstruct `tramp-file-name' as central data structure. |
|
Date: |
Wed, 24 May 2017 10:18:08 -0400 (EDT) |
branch: master
commit dca22e86e02d16a31128c163925b13404f777c0f
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>
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.
---
lisp/net/tramp-adb.el | 21 ++--
lisp/net/tramp-cache.el | 136 ++++++++++++++-----------
lisp/net/tramp-cmds.el | 2 +
lisp/net/tramp-ftp.el | 2 +-
lisp/net/tramp-gvfs.el | 31 ++++--
lisp/net/tramp-sh.el | 38 +++----
lisp/net/tramp-smb.el | 87 +++++++---------
lisp/net/tramp.el | 265 +++++++++++++++++++++++++-----------------------
8 files changed, 301 insertions(+), 281 deletions(-)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 2825532..1c894c9 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -199,8 +199,9 @@ pass to the OPERATION."
;; That's why we use `start-process'.
(let ((p (start-process
tramp-adb-program (current-buffer) tramp-adb-program "devices"))
- (v (vector tramp-adb-method tramp-current-user
- tramp-current-host nil nil))
+ (v (tramp-make-tramp-file-name
+ tramp-adb-method tramp-current-user nil
+ tramp-current-host nil nil nil))
result)
(tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " "))
(process-put p 'adjust-window-size-function 'ignore)
@@ -242,7 +243,7 @@ pass to the OPERATION."
;; be problems with UNC shares or Cygwin mounts.
(let ((default-directory (tramp-compat-temporary-file-directory)))
(tramp-make-tramp-file-name
- method user host
+ method user domain host port
(tramp-drop-volume-letter
(tramp-run-real-handler
'expand-file-name (list localname))))))))
@@ -261,7 +262,7 @@ pass to the OPERATION."
"%s%s"
(with-parsed-tramp-file-name (expand-file-name filename) nil
(tramp-make-tramp-file-name
- method user host
+ method user domain host port
(with-tramp-file-property v localname "file-truename"
(let ((result nil)) ; result steps in reverse order
(tramp-message v 4 "Finding true name for `%s'" filename)
@@ -289,7 +290,7 @@ pass to the OPERATION."
(tramp-compat-file-attribute-type
(file-attributes
(tramp-make-tramp-file-name
- method user host
+ method user domain host port
(mapconcat 'identity
(append '("")
(reverse result)
@@ -687,7 +688,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
newname (expand-file-name newname))
(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))
(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))
;; INFILE must be copied to remote host.
(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)))
(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.
(setq stderr (tramp-make-tramp-temp-file v)
tmpstderr (tramp-make-tramp-file-name
- method user host stderr))))
+ method user domain host port stderr))))
;; stderr to be discarded.
((null (cadr destination))
(setq stderr "/dev/null"))))
@@ -1199,8 +1201,7 @@ connection if a previous connection has died for some
reason."
(device (tramp-adb-get-device vec)))
;; Set variables for proper tracing in `tramp-adb-parse-device-names'.
- (setq tramp-current-method (tramp-file-name-method vec)
- tramp-current-user (tramp-file-name-user vec)
+ (setq tramp-current-user (tramp-file-name-user vec)
tramp-current-host (tramp-file-name-host vec))
;; Maybe we know already that "su" is not supported. We cannot
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 64268cf..a9a1c66 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -27,9 +27,9 @@
;; An implementation of information caching for remote files.
-;; Each connection, identified by a vector [method user host
-;; localname] or by a process, has a unique cache. We distinguish 3
-;; kind of caches, depending on the key:
+;; Each connection, identified by a `tramp-file-name' structure or by
+;; a process, has a unique cache. We distinguish 3 kind of caches,
+;; depending on the key:
;;
;; - localname is NIL. This are reusable properties. Examples:
;; "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)
(let ((hash
(puthash key (make-hash-table :test 'equal) tramp-cache-data)))
- (when (vectorp key)
+ (when (tramp-file-name-p key)
(dolist (elt tramp-connection-properties)
(when (string-match
(or (nth 0 elt) "")
(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)))))
hash)))
@@ -107,11 +109,12 @@ matching entries of `tramp-connection-properties'."
(defun tramp-get-file-property (key file property default)
"Get the PROPERTY of FILE from the cache context of KEY.
Returns DEFAULT if not set."
- ;; Unify localname. Remove hop from vector.
- (setq file (tramp-compat-file-name-unquote file))
- (setq key (copy-sequence key))
- (aset key 3 (tramp-run-real-handler 'directory-file-name (list file)))
- (aset key 4 nil)
+ ;; Unify localname. Remove hop from `tramp-file-name' structure.
+ (setq file (tramp-compat-file-name-unquote file)
+ key (copy-tramp-file-name key))
+ (setf (tramp-file-name-localname key)
+ (tramp-run-real-handler 'directory-file-name (list file))
+ (tramp-file-name-hop key) nil)
(let* ((hash (tramp-get-hash-table key))
(value (when (hash-table-p hash) (gethash property hash))))
(if
@@ -141,11 +144,12 @@ Returns DEFAULT if not set."
(defun tramp-set-file-property (key file property value)
"Set the PROPERTY of FILE to VALUE, in the cache context of KEY.
Returns VALUE."
- ;; Unify localname. Remove hop from vector.
- (setq file (tramp-compat-file-name-unquote file))
- (setq key (copy-sequence key))
- (aset key 3 (tramp-run-real-handler 'directory-file-name (list file)))
- (aset key 4 nil)
+ ;; Unify localname. Remove hop from `tramp-file-name' structure.
+ (setq file (tramp-compat-file-name-unquote file)
+ key (copy-tramp-file-name key))
+ (setf (tramp-file-name-localname key)
+ (tramp-run-real-handler 'directory-file-name (list file))
+ (tramp-file-name-hop key) nil)
(let ((hash (tramp-get-hash-table key)))
;; We put the timestamp there.
(puthash property (cons (current-time) value) hash)
@@ -162,11 +166,11 @@ Returns VALUE."
(let* ((file (tramp-run-real-handler
'directory-file-name (list file)))
(truename (tramp-get-file-property key file "file-truename" nil)))
- ;; Unify localname. Remove hop from vector.
- (setq file (tramp-compat-file-name-unquote file))
- (setq key (copy-sequence key))
- (aset key 3 file)
- (aset key 4 nil)
+ ;; Unify localname. Remove hop from `tramp-file-name' structure.
+ (setq file (tramp-compat-file-name-unquote file)
+ key (copy-tramp-file-name key))
+ (setf (tramp-file-name-localname key) file
+ (tramp-file-name-hop key) nil)
(tramp-message key 8 "%s" file)
(remhash key tramp-cache-data)
;; Remove file properties of symlinks.
@@ -185,7 +189,8 @@ Remove also properties of all files in subdirectories."
(tramp-message key 8 "%s" directory)
(maphash
(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)
(tramp-file-name-localname key)))
(remhash key tramp-cache-data)))
@@ -232,15 +237,15 @@ This is suppressed for temporary buffers."
(defun tramp-get-connection-property (key property default)
"Get the named PROPERTY for the connection.
KEY identifies the connection, it is either a process or a
-vector. A special case is nil, which is used to cache connection
-properties of the local machine. If the value is not set for the
-connection, returns DEFAULT."
- ;; Unify key by removing localname and hop from vector. Work with a
- ;; copy in order to avoid side effects.
- (when (vectorp key)
- (setq key (copy-sequence key))
- (aset key 3 nil)
- (aset key 4 nil))
+`tramp-file-name' structure. A special case is nil, which is
+used to cache connection properties of the local machine. If the
+value is not set for the connection, returns DEFAULT."
+ ;; Unify key by removing localname and hop from `tramp-file-name'
+ ;; structure. Work with a copy in order to avoid side effects.
+ (when (tramp-file-name-p key)
+ (setq key (copy-tramp-file-name key))
+ (setf (tramp-file-name-localname key) nil
+ (tramp-file-name-hop key) nil))
(let* ((hash (tramp-get-hash-table key))
(value
;; 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)
"Set the named PROPERTY of a connection to VALUE.
KEY identifies the connection, it is either a process or a
-vector. A special case is nil, which is used to cache connection
-properties of the local machine. PROPERTY is set persistent when
-KEY is a vector."
- ;; Unify key by removing localname and hop from vector. Work with a
- ;; copy in order to avoid side effects.
- (when (vectorp key)
- (setq key (copy-sequence key))
- (aset key 3 nil)
- (aset key 4 nil))
+`tramp-file-name' structure. A special case is nil, which is
+used to cache connection properties of the local machine.
+PROPERTY is set persistent when KEY is a `tramp-file-name' structure."
+ ;; Unify key by removing localname and hop from `tramp-file-name'
+ ;; structure. Work with a copy in order to avoid side effects.
+ (when (tramp-file-name-p key)
+ (setq key (copy-tramp-file-name key))
+ (setf (tramp-file-name-localname key) nil
+ (tramp-file-name-hop key) nil))
(let ((hash (tramp-get-hash-table key)))
(puthash property value hash)
(setq tramp-cache-data-changed t)
@@ -276,22 +281,22 @@ KEY is a vector."
(defun tramp-connection-property-p (key property)
"Check whether named PROPERTY of a connection is defined.
KEY identifies the connection, it is either a process or a
-vector. A special case is nil, which is used to cache connection
-properties of the local machine."
+`tramp-file-name' structure. A special case is nil, which is
+used to cache connection properties of the local machine."
(not (eq (tramp-get-connection-property key property 'undef) 'undef)))
;;;###tramp-autoload
(defun tramp-flush-connection-property (key)
"Remove all properties identified by KEY.
KEY identifies the connection, it is either a process or a
-vector. A special case is nil, which is used to cache connection
-properties of the local machine."
- ;; Unify key by removing localname and hop from vector. Work with a
- ;; copy in order to avoid side effects.
- (when (vectorp key)
- (setq key (copy-sequence key))
- (aset key 3 nil)
- (aset key 4 nil))
+`tramp-file-name' structure. A special case is nil, which is
+used to cache connection properties of the local machine."
+ ;; Unify key by removing localname and hop from `tramp-file-name'
+ ;; structure. Work with a copy in order to avoid side effects.
+ (when (tramp-file-name-p key)
+ (setq key (copy-tramp-file-name key))
+ (setf (tramp-file-name-localname key) nil
+ (tramp-file-name-hop key) nil))
(tramp-message
key 7 "%s %s" key
(let ((hash (gethash key tramp-cache-data))
@@ -310,7 +315,16 @@ properties of the local machine."
(maphash
(lambda (key 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))
(when (stringp (aref key i))
(aset key i (substring-no-properties (aref key i))))))
@@ -335,11 +349,12 @@ properties of the local machine."
;;;###tramp-autoload
(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)
(maphash
(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"))
(add-to-list 'result key)))
tramp-cache-data)
@@ -361,7 +376,7 @@ properties of the local machine."
;; possibility to use another login name later on.
(maphash
(lambda (key value)
- (if (and (vectorp key)
+ (if (and (tramp-file-name-p key)
(not (tramp-file-name-localname key))
(not (gethash "login-as" value)))
(progn
@@ -402,7 +417,7 @@ for all methods. Resulting data are derived from
connection history."
(let (res)
(maphash
(lambda (key _value)
- (if (and (vectorp key)
+ (if (and (tramp-file-name-p key)
(string-equal method (tramp-file-name-method key))
(not (tramp-file-name-localname 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)
(while (setq element (pop list))
(setq key (pop element))
- (while (setq item (pop element))
- ;; We set only values which are not contained in
- ;; `tramp-connection-properties'. The cache is
- ;; initialized properly by side effect.
- (unless (tramp-connection-property-p key (car item))
- (tramp-set-connection-property key (pop item) (car item))))))
+ (when (tramp-file-name-p key)
+ (while (setq item (pop element))
+ ;; We set only values which are not contained in
+ ;; `tramp-connection-properties'. The cache is
+ ;; initialized properly by side effect.
+ (unless (tramp-connection-property-p key (car item))
+ (tramp-set-connection-property key (pop item) (car item)))))))
(setq tramp-cache-data-changed nil))
(file-error
;; Most likely because the file doesn't exist yet. No message.
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 4007b65..4c5a12d 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -85,7 +85,9 @@ When called interactively, a Tramp connection has to be
selected."
(tramp-make-tramp-file-name
(tramp-file-name-method x)
(tramp-file-name-user x)
+ (tramp-file-name-domain x)
(tramp-file-name-host x)
+ (tramp-file-name-port x)
(tramp-file-name-localname x)))
(tramp-list-connections)))
name)
diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el
index 8d1900d..44a4cca 100644
--- a/lisp/net/tramp-ftp.el
+++ b/lisp/net/tramp-ftp.el
@@ -145,7 +145,7 @@ pass to the OPERATION."
((memq operation '(file-directory-p file-exists-p))
(if (apply 'ange-ftp-hook-function operation args)
(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))
nil))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index cf3906a..ad9bd81 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -807,7 +807,8 @@ file names."
;; If there is a default location, expand tilde.
(when (string-match "\\`\\(~\\)\\(/\\|\\'\\)" localname)
(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
(replace-match
(tramp-get-connection-property v "default-location" "~")
@@ -831,7 +832,7 @@ file names."
;; No tilde characters in file name, do normal
;; `expand-file-name' (this does "/./" and "/../").
(tramp-make-tramp-file-name
- method user host
+ method user domain host port
(tramp-run-real-handler
'expand-file-name (list localname))))))
@@ -1249,7 +1250,7 @@ file-notify events."
(concat (match-string 2 user) ";" (match-string 1 user))))
(url-parse-make-urlobj
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))
(url-parse-make-urlobj
"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.
nil ;; no abort of D-Bus.
password
- (tramp-file-name-real-user l)
+ (tramp-file-name-user l)
domain
nil ;; not anonymous.
0) ;; no password save.
;; 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.
(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))
(setq host (concat host tramp-prefix-port-format port)))
(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
v 6 "%s %s"
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)
"Return a mount-spec for \"org.gtk.vfs.MountTracker.mountLocation\"."
(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))
- (host (tramp-file-name-real-host vec))
+ (host (tramp-file-name-host vec))
(port (tramp-file-name-port vec))
(localname (tramp-file-name-unquote-localname vec))
(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)
(let ((method (tramp-file-name-method vec))
(user (tramp-file-name-user vec))
+ (domain (tramp-file-name-domain vec))
(host (tramp-file-name-host vec))
+ (port (tramp-file-name-port vec))
(localname
(tramp-get-connection-property vec "default-location" nil)))
(cond
@@ -1599,7 +1602,8 @@ ID-FORMAT valid values are `string' and `integer'."
(localname
(tramp-compat-file-attribute-user-id
(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 '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)
(let ((method (tramp-file-name-method vec))
(user (tramp-file-name-user vec))
+ (domain (tramp-file-name-domain vec))
(host (tramp-file-name-host vec))
+ (port (tramp-file-name-port vec))
(localname
(tramp-get-connection-property vec "default-location" nil)))
(cond
(localname
(tramp-compat-file-attribute-group-id
(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 '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)
(let* ((method (tramp-file-name-method vec))
(user (tramp-file-name-user vec))
+ (domain (tramp-file-name-domain vec))
(host (tramp-file-name-host vec))
+ (port (tramp-file-name-port vec))
(localname (tramp-file-name-unquote-localname vec))
(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")
(string-equal localname "/"))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 999de8e..4b89c17 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1122,7 +1122,7 @@ target of the symlink differ."
"%s%s"
(with-parsed-tramp-file-name (expand-file-name filename) nil
(tramp-make-tramp-file-name
- method user host
+ method user domain host port
(with-tramp-file-property v localname "file-truename"
(let ((result nil) ; result steps in reverse order
(quoted (tramp-compat-file-name-quoted-p localname))
@@ -1174,7 +1174,7 @@ target of the symlink differ."
(tramp-compat-file-attribute-type
(file-attributes
(tramp-make-tramp-file-name
- method user host
+ method user domain host port
(mapconcat 'identity
(append '("")
(reverse result)
@@ -2335,7 +2335,7 @@ The method used must be an out-of-band method."
(let* ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p 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)
(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-get-connection-property
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.
(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-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.
(setq user (or (tramp-file-name-user v)
(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.
(let ((default-directory (tramp-compat-temporary-file-directory)))
(tramp-make-tramp-file-name
- method user host
+ method user domain host port
(tramp-drop-volume-letter
(tramp-run-real-handler
'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-file-name-method v)
(tramp-file-name-user v)
+ (tramp-file-name-domain v)
(tramp-file-name-host v)
+ (tramp-file-name-port v)
(tramp-file-name-localname v))
tramp-initial-end-of-output))
;; 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))
;; INFILE must be copied to remote host.
(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)))
(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.
(setq stderr (tramp-make-tramp-temp-file v)
tmpstderr (tramp-make-tramp-file-name
- method user host stderr))))
+ method user domain host port stderr))))
;; stderr to be discarded.
((null (cadr destination))
(setq stderr "/dev/null"))))
@@ -4546,7 +4545,7 @@ Goes through the list `tramp-inline-compress-commands'."
;; host name.
(let* ((v (car target-alist))
(method (tramp-file-name-method v))
- (host (tramp-file-name-real-host v)))
+ (host (tramp-file-name-host v)))
(unless
(or
;; 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,
;; there is a problem. We shall signal this.
(unless (or (tramp-compat-process-live-p p)
- (not (equal (butlast (append vec nil) 2)
- (car tramp-current-connection)))
+ (not (tramp-file-name-equal-p
+ vec (car tramp-current-connection)))
(> (tramp-time-diff
(current-time) (cdr tramp-current-connection))
(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)
(process-put p 'adjust-window-size-function 'ignore)
(set-process-query-on-exit-flag p nil)
- (setq tramp-current-connection
- (cons (butlast (append vec nil) 2) (current-time))
+ (setq tramp-current-connection (cons vec (current-time))
tramp-current-host (system-name))
(tramp-message
@@ -5104,7 +5102,7 @@ Return ATTR."
"Create a file name suitable for `scp', `pscp', or `nc' and workalikes."
(let ((method (tramp-file-name-method vec))
(user (tramp-file-name-user vec))
- (host (tramp-file-name-real-host vec))
+ (host (tramp-file-name-host vec))
(localname
(directory-file-name (tramp-file-name-unquote-localname vec))))
(when (string-match tramp-ipv6-regexp host)
@@ -5218,7 +5216,9 @@ Nonexistent directories are removed from spec."
(tramp-make-tramp-file-name
(tramp-file-name-method vec)
(tramp-file-name-user vec)
+ (tramp-file-name-domain vec)
(tramp-file-name-host vec)
+ (tramp-file-name-port vec)
x))
x))
remote-path)))))
@@ -5636,14 +5636,14 @@ function cell is returned to be applied on a buffer."
(let ((coding-system-for-write 'binary)
(coding-system-for-read 'binary))
(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
(cdr (split-string ,compress)))))
`(lambda (beg end)
(let ((coding-system-for-write 'binary)
(coding-system-for-read 'binary))
(apply
- 'tramp-call-process-region ,vec beg end
+ 'tramp-call-process-region ',vec beg end
(car (split-string ,compress)) t t nil
(cdr (split-string ,compress))))
(,coding (point-min) (point-max)))))
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 12eb367..7b2a1ba 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -53,12 +53,6 @@
;; Another guess. We might implement a better check later on.
(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,
;; the anonymous user is chosen.
;;;###tramp-autoload
@@ -449,15 +443,11 @@ pass to the OPERATION."
(if (not (file-directory-p newname))
(make-directory newname parents))
- (setq tramp-current-method (tramp-file-name-method v)
- tramp-current-user (tramp-file-name-user v)
- tramp-current-host (tramp-file-name-real-host v))
+ (setq tramp-current-method method
+ tramp-current-user user
+ tramp-current-host host)
- (let* ((real-user (tramp-file-name-real-user 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))
+ (let* ((share (tramp-smb-get-share v))
(localname (file-name-as-directory
(replace-regexp-in-string
"\\\\" "/" (tramp-smb-get-localname v))))
@@ -465,10 +455,10 @@ pass to the OPERATION."
(expand-file-name
tramp-temp-name-prefix
(tramp-compat-temporary-file-directory))))
- (args (list (concat "//" real-host "/" share) "-E")))
+ (args (list (concat "//" host "/" share) "-E")))
- (if (not (zerop (length real-user)))
- (setq args (append args (list "-U" real-user)))
+ (if (not (zerop (length user)))
+ (setq args (append args (list "-U" user)))
(setq args (append args (list "-N"))))
(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
(replace-match
(if (zerop (length (match-string 1 localname)))
- (tramp-file-name-real-user v)
+ user
(match-string 1 localname))
nil nil localname)))
;; 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
;; `expand-file-name' (this does "/./" and "/../").
(tramp-make-tramp-file-name
- method user host
+ method user domain host port
(tramp-run-real-handler 'expand-file-name (list localname))))))
(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"
(when (executable-find tramp-smb-acl-program)
- (setq tramp-current-method (tramp-file-name-method v)
- tramp-current-user (tramp-file-name-user v)
- tramp-current-host (tramp-file-name-real-host v))
+ (setq tramp-current-method method
+ tramp-current-user user
+ tramp-current-host host)
- (let* ((real-user (tramp-file-name-real-user 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))
+ (let* ((share (tramp-smb-get-share v))
(localname (replace-regexp-in-string
"\\\\" "/" (tramp-smb-get-localname v)))
- (args (list (concat "//" real-host "/" share) "-E")))
+ (args (list (concat "//" host "/" share) "-E")))
- (if (not (zerop (length real-user)))
- (setq args (append args (list "-U" real-user)))
+ (if (not (zerop (length user)))
+ (setq args (append args (list "-U" user)))
(setq args (append args (list "-N"))))
(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))
;; INFILE must be copied to remote host.
(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))
;; Transform input into a filename powershell does understand.
(setq input (format "//%s%s" host input)))
@@ -1337,24 +1324,20 @@ target of the symlink differ."
(ignore-errors
(with-parsed-tramp-file-name filename nil
(when (and (stringp acl-string) (executable-find tramp-smb-acl-program))
- (setq tramp-current-method (tramp-file-name-method v)
- tramp-current-user (tramp-file-name-user v)
- tramp-current-host (tramp-file-name-real-host v))
+ (setq tramp-current-method method
+ tramp-current-user user
+ tramp-current-host host)
(tramp-set-file-property v localname "file-acl" 'undef)
- (let* ((real-user (tramp-file-name-real-user 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))
+ (let* ((share (tramp-smb-get-share v))
(localname (replace-regexp-in-string
"\\\\" "/" (tramp-smb-get-localname v)))
- (args (list (concat "//" real-host "/" share) "-E" "-S"
+ (args (list (concat "//" host "/" share) "-E" "-S"
(replace-regexp-in-string
"\n" "," acl-string))))
- (if (not (zerop (length real-user)))
- (setq args (append args (list "-U" real-user)))
+ (if (not (zerop (length user)))
+ (setq args (append args (list "-U" user)))
(setq args (append args (list "-N"))))
(when domain (setq args (append args (list "-W" domain))))
@@ -1845,24 +1828,22 @@ If ARGUMENT is non-nil, use it as argument for
(when buf (with-current-buffer buf (erase-buffer)))
(when (and p (processp p)) (delete-process p))
- (let* ((user (tramp-file-name-user 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))
- (port (tramp-file-name-port vec))
+ (let* ((user (tramp-file-name-user vec))
+ (host (tramp-file-name-host vec))
+ (domain (tramp-file-name-domain vec))
+ (port (tramp-file-name-port vec))
args)
(cond
(argument
- (setq args (list (concat "//" real-host))))
+ (setq args (list (concat "//" host))))
(share
- (setq args (list (concat "//" real-host "/" share))))
+ (setq args (list (concat "//" host "/" share))))
(t
- (setq args (list "-g" "-L" real-host ))))
+ (setq args (list "-g" "-L" host ))))
- (if (not (zerop (length real-user)))
- (setq args (append args (list "-U" real-user)))
+ (if (not (zerop (length user)))
+ (setq args (append args (list "-U" user)))
(setq args (append args (list "-N"))))
(when domain (setq args (append args (list "-W" domain))))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 70abb89..c481ec6 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1099,9 +1099,15 @@ means to use always cached values for the directory
contents."
(defvar tramp-current-user nil
"Remote login name for this *tramp* buffer.")
+(defvar tramp-current-domain nil
+ "Remote domain name for this *tramp* buffer.")
+
(defvar tramp-current-host nil
"Remote host for this *tramp* buffer.")
+(defvar tramp-current-port nil
+ "Remote port for this *tramp* buffer.")
+
(defvar tramp-current-connection nil
"Last connection timestamp.")
@@ -1128,6 +1134,37 @@ calling HANDLER.")
;; internal data structure. Convenience functions for internal
;; 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)
"Return the method parameter PARAM.
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))))
(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.
(defun tramp-file-name-unquote-localname (vec)
"Return unquoted localname component of VEC."
@@ -1299,43 +1273,67 @@ values."
(user (match-string (nth 2 (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))
- (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 (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)
(setq host (replace-match "" nil t host)))
(when (string-match (tramp-postfix-ipv6-regexp) host)
(setq host (replace-match "" nil t host))))
- (if nodefault
- (vector method user host localname hop)
- (vector
- (tramp-find-method method user host)
- (tramp-find-user method user host)
- (tramp-find-host method user host)
- localname hop))))))
+
+ (unless nodefault
+ (setq method (tramp-find-method method user host)
+ user (tramp-find-user method user host)
+ host (tramp-find-host method user host)))
+
+ (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)
"A name for the connection buffer VEC."
(let ((method (tramp-file-name-method vec))
- (user (tramp-file-name-user vec))
- (host (tramp-file-name-real-host vec)))
- (if (not (zerop (length user)))
- (format "*tramp/%s address@hidden" method user host)
- (format "*tramp/%s %s*" method host))))
-
-(defun tramp-make-tramp-file-name (method user host localname &optional hop)
+ (user-domain (tramp-file-name-user-domain vec))
+ (host-port (tramp-file-name-host-port vec)))
+ (if (not (zerop (length user-domain)))
+ (format "*tramp/%s address@hidden" method user-domain host-port)
+ (format "*tramp/%s %s*" method host-port))))
+
+(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.
-When not nil, an optional HOP is prepended."
+When not nil, optional DOMAIN, PORT and HOP are used."
(concat (tramp-prefix-format) hop
(unless (or (zerop (length method))
(zerop (length (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))
- (concat user tramp-postfix-user-format))
+ tramp-postfix-user-format)
(when host
(if (string-match tramp-ipv6-regexp host)
(concat
(tramp-prefix-ipv6-format) host (tramp-postfix-ipv6-format))
host))
+ (unless (zerop (length port))
+ (concat tramp-prefix-port-format port))
(tramp-postfix-host-format)
(when localname localname)))
@@ -1372,7 +1370,9 @@ necessary only. This function will be used in file name
completion."
(tramp-make-tramp-file-name
(tramp-file-name-method vec)
(tramp-file-name-user vec)
+ (tramp-file-name-domain vec)
(tramp-file-name-host vec)
+ (tramp-file-name-port vec)
"/"))
(current-buffer))))
@@ -1406,8 +1406,8 @@ version, the function does nothing."
'hack-connection-local-variables-apply
`(:application tramp
:protocol ,(tramp-file-name-method vec)
- :user ,(tramp-file-name-user vec)
- :machine ,(tramp-file-name-host vec)))))
+ :user ,(tramp-file-name-user-domain vec)
+ :machine ,(tramp-file-name-host-port vec)))))
(defun tramp-set-connection-local-variables-for-buffer ()
"Set connection-local variables in the current buffer.
@@ -1425,11 +1425,11 @@ version, the function does nothing."
(defun tramp-debug-buffer-name (vec)
"A name for the debug buffer for VEC."
(let ((method (tramp-file-name-method vec))
- (user (tramp-file-name-user vec))
- (host (tramp-file-name-real-host vec)))
- (if (not (zerop (length user)))
- (format "*debug tramp/%s address@hidden" method user host)
- (format "*debug tramp/%s %s*" method host))))
+ (user-domain (tramp-file-name-user-domain vec))
+ (host-port (tramp-file-name-host-port vec)))
+ (if (not (zerop (length user-domain)))
+ (format "*debug tramp/%s address@hidden" method user-domain host-port)
+ (format "*debug tramp/%s %s*" method host-port))))
(defconst tramp-debug-outline-regexp
"[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")
arguments (append arguments (list (buffer-string)))))))
;; Do it.
- (when (vectorp vec-or-proc)
+ (when (tramp-file-name-p vec-or-proc)
(apply 'tramp-debug-message
vec-or-proc
(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
(let* ((buf (or (and (bufferp buf) buf)
(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))))
- (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
(tramp-dissect-file-name default-directory))))))
(unwind-protect
@@ -1639,8 +1639,7 @@ an input event arrives. The other arguments are passed
to `tramp-error'."
(discard-input)
(sit-for 30)))
;; Reset timestamp. It would be wrong after waiting for a while.
- (when (equal (butlast (append vec nil) 2)
- (car tramp-current-connection))
+ (when (tramp-file-name-equal-p vec (car tramp-current-connection))
(setcdr tramp-current-connection (current-time)))))))
(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)
(,(intern (format "tramp-file-name-%s" elem))
,(or var 'v))))
- '(method user host localname hop))))
+ '(method user domain host port localname hop))))
`(let* ((,(or var 'v) (tramp-dissect-file-name ,filename))
,@bindings)
;; 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
(when (string-match (nth 0 structure) name)
- (let ((method (and (nth 1 structure)
- (match-string (nth 1 structure) name)))
- (user (and (nth 2 structure)
- (match-string (nth 2 structure) name)))
- (host (and (nth 3 structure)
- (match-string (nth 3 structure) name)))
- (localname (and (nth 4 structure)
- (match-string (nth 4 structure) name))))
- (vector method user host localname nil)))))
+ (make-tramp-file-name
+ :method (and (nth 1 structure)
+ (match-string (nth 1 structure) name))
+ :user (and (nth 2 structure)
+ (match-string (nth 2 structure) name))
+ :host (and (nth 3 structure)
+ (match-string (nth 3 structure) name))))))
;; This function returns all possible method completions, adding the
;; trailing method delimiter.
@@ -2862,7 +2859,9 @@ User is always nil."
(tramp-make-tramp-file-name
(tramp-file-name-method v)
(tramp-file-name-user v)
+ (tramp-file-name-domain v)
(tramp-file-name-host v)
+ (tramp-file-name-port v)
(if (and (zerop (length (tramp-file-name-localname v)))
(not (tramp-connectable-p file)))
""
@@ -2951,7 +2950,9 @@ User is always nil."
(tramp-make-tramp-file-name
(tramp-file-name-method v)
(tramp-file-name-user v)
+ (tramp-file-name-domain v)
(tramp-file-name-host v)
+ (tramp-file-name-port v)
(tramp-run-real-handler
'file-name-directory (list (or (tramp-file-name-localname v) "")))
(tramp-file-name-hop v))))
@@ -2993,11 +2994,13 @@ User is always nil."
(and (or (not connected) c)
(cond
((eq identification 'method) method)
- ((eq identification 'user) user)
- ((eq identification 'host) host)
+ ;; Domain and port are appended.
+ ((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)
- (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)
"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))))
(when (stringp 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)))))
(defun tramp-handle-find-backup-file-name (filename)
@@ -3020,7 +3023,8 @@ User is always nil."
(if (and (stringp (cdr x))
(file-name-absolute-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))))
tramp-backup-directory-alist)
backup-directory-alist)))
@@ -3125,7 +3129,7 @@ User is always nil."
((stringp remote-copy)
(file-local-copy
(tramp-make-tramp-file-name
- method user host remote-copy)))
+ method user domain host port remote-copy)))
((stringp tramp-temp-buffer-file-name)
(copy-file
filename tramp-temp-buffer-file-name 'ok)
@@ -3170,7 +3174,8 @@ User is always nil."
(delete-file local-copy))
(when (stringp remote-copy)
(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.
(list (expand-file-name filename)
@@ -3548,7 +3553,8 @@ connection buffer."
(tramp-set-connection-property
(tramp-dissect-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)
(save-restriction
(with-tramp-progress-reporter
@@ -3933,7 +3939,9 @@ be granted."
(tramp-make-tramp-file-name
(tramp-file-name-method vec)
(tramp-file-name-user vec)
+ (tramp-file-name-domain vec)
(tramp-file-name-host vec)
+ (tramp-file-name-port vec)
(tramp-file-name-localname vec)
(tramp-file-name-hop vec))
(intern suffix))))
@@ -3979,12 +3987,13 @@ be granted."
;;;###tramp-autoload
(defun tramp-local-host-p (vec)
"Return t if this points to the local host, nil otherwise."
- ;; We cannot use `tramp-file-name-real-host'. A port is an
- ;; indication for an ssh tunnel or alike.
- (let ((host (tramp-file-name-host vec)))
+ (let ((host (tramp-file-name-host vec))
+ (port (tramp-file-name-port vec)))
(and
(stringp 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
;; handlers. `tramp-local-host-p' is also called for "smb" and
;; alike, where it must fail.
@@ -3994,7 +4003,8 @@ be granted."
(tramp-make-tramp-file-name
(tramp-file-name-method vec)
(tramp-file-name-user vec)
- host
+ (tramp-file-name-domain vec)
+ host port
(tramp-compat-temporary-file-directory)))
;; On some systems, chown runs only for root.
(or (zerop (user-uid))
@@ -4008,7 +4018,9 @@ be granted."
(let ((dir (tramp-make-tramp-file-name
(tramp-file-name-method vec)
(tramp-file-name-user vec)
+ (tramp-file-name-domain vec)
(tramp-file-name-host vec)
+ (tramp-file-name-port vec)
(or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp")
(tramp-file-name-hop vec))))
(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."
(let ((default-directory (tramp-compat-temporary-file-directory))
(v (or vec
- (vector tramp-current-method tramp-current-user
- tramp-current-host nil nil)))
+ (tramp-make-tramp-file-name
+ 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))
output error result)
(tramp-message
@@ -4159,8 +4172,9 @@ PROGRAM is nil is trapped also, returning 1.
Furthermore, traces
are written with verbosity of 6."
(let ((default-directory (tramp-compat-temporary-file-directory))
(v (or vec
- (vector tramp-current-method tramp-current-user
- tramp-current-host nil nil)))
+ (tramp-make-tramp-file-name
+ 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))
result)
(tramp-message
@@ -4191,8 +4205,8 @@ Consults the auth-source package.
Invokes `password-read' if available, `read-passwd' else."
(let* ((case-fold-search t)
(key (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 ""))
(pw-prompt
(or prompt
(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."
(let ((method (tramp-file-name-method vec))
(user (tramp-file-name-user vec))
+ (domain (tramp-file-name-domain vec))
(host (tramp-file-name-host vec))
+ (port (tramp-file-name-port vec))
(hop (tramp-file-name-hop vec)))
(when hop
;; 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))
(tramp-compat-funcall
'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.
@@ -4393,12 +4410,6 @@ Only works for Bourne-like shells."
;; <http://www.mail-archive.com/address@hidden/msg01041.html>.
;; (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
;; *-process-file. One idea is to generalize `tramp-send-command'
;; and friends, for most of the handlers this is the major