From dca22e86e02d16a31128c163925b13404f777c0f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 24 May 2017 16:16:53 +0200 Subject: [PATCH] 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 2825532c525..1c894c9b0c5 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 64268cfc25a..a9a1c6615ea 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 4007b65c3af..4c5a12d33ba 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 8d1900d4e36..44a4ccadaca 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 cf3906aef36..ad9bd819c02 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 999de8e8504..4b89c173471 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 12eb3679513..7b2a1ba874d 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 70abb89194d..c481ec66ce6 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 %s@%s*" 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 %s@%s*" 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 %s@%s*" 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 %s@%s*" 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." ;; . ;; (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 -- 2.39.2