[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/tramp f1e00a4adb: Tramp ELPA version 2.6.0 released
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/tramp f1e00a4adb: Tramp ELPA version 2.6.0 released |
|
Date: |
Fri, 30 Dec 2022 05:58:24 -0500 (EST) |
branch: externals/tramp
commit f1e00a4adb4de8f322f48cceec7e5c8bd3b298b6
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>
Tramp ELPA version 2.6.0 released
---
Makefile | 1 +
README | 6 +-
test/tramp-tests.el | 1994 +++++++++++++++++++++----------------
texi/tramp.texi | 883 ++++++++++++-----
texi/trampelpa.texi | 19 +-
texi/trampver.texi | 14 +-
tramp-adb.el | 801 ++++++++-------
tramp-archive.el | 112 ++-
tramp-cache.el | 372 ++++---
tramp-cmds.el | 78 +-
tramp-compat.el | 282 +++---
tramp-container.el | 214 ++++
tramp-crypt.el | 194 ++--
tramp-ftp.el | 30 +-
tramp-fuse.el | 69 +-
tramp-gvfs.el | 578 ++++++-----
tramp-integration.el | 306 +++++-
tramp-rclone.el | 115 ++-
tramp-sh.el | 2625 ++++++++++++++++++++++++++-----------------------
tramp-smb.el | 1309 ++++++++++++-------------
tramp-sshfs.el | 88 +-
tramp-sudoedit.el | 491 +++++-----
tramp-uu.el | 2 +-
tramp.el | 2667 ++++++++++++++++++++++++++++++++------------------
trampver.el | 23 +-
25 files changed, 7752 insertions(+), 5521 deletions(-)
diff --git a/Makefile b/Makefile
index 92d3c53afd..15cbb91118 100644
--- a/Makefile
+++ b/Makefile
@@ -55,6 +55,7 @@ sync:
cp -p $(SOURCE_DIR)/lisp/tramp-cache.el tramp-cache.el
cp -p $(SOURCE_DIR)/lisp/tramp-cmds.el tramp-cmds.el
cp -p $(SOURCE_DIR)/lisp/tramp-compat.el tramp-compat.el
+ cp -p $(SOURCE_DIR)/lisp/tramp-container.el tramp-container.el
cp -p $(SOURCE_DIR)/lisp/tramp-crypt.el tramp-crypt.el
cp -p $(SOURCE_DIR)/lisp/tramp-ftp.el tramp-ftp.el
cp -p $(SOURCE_DIR)/lisp/tramp-fuse.el tramp-fuse.el
diff --git a/README b/README
index 1b8f5f77b0..c9bcbe9010 100644
--- a/README
+++ b/README
@@ -1,4 +1,4 @@
-Installing TRAMP via GNU ELPA
+Installing Tramp via GNU ELPA
*****************************
Tramp stands for "Transparent Remote (file) Access, Multiple Protocol".
@@ -22,11 +22,11 @@ installed with, you must recompile the package:
* Remove all byte-compiled Tramp files
- $ rm -f ~/.emacs.d/elpa/tramp-2.5.4/tramp*.elc
+ $ rm -f ~/.emacs.d/elpa/tramp-2.6.0/tramp*.elc
* Start Emacs with Tramp's source files
- $ emacs -L ~/.emacs.d/elpa/tramp-2.5.4 -l tramp
+ $ emacs -L ~/.emacs.d/elpa/tramp-2.6.0 -l tramp
This should not give you the error.
diff --git a/test/tramp-tests.el b/test/tramp-tests.el
index 06920ad534..8d63bb3de9 100644
--- a/test/tramp-tests.el
+++ b/test/tramp-tests.el
@@ -43,10 +43,12 @@
(require 'cl-lib)
(require 'dired)
-(require 'ert)
+(require 'dired-aux)
+(require 'tramp)
(require 'ert-x)
+(require 'seq) ; For `seq-random-elt', autoloaded since Emacs 28.1
+(require 'tar-mode)
(require 'trace)
-(require 'tramp)
(require 'vc)
(require 'vc-bzr)
(require 'vc-git)
@@ -62,9 +64,6 @@
(declare-function tramp-method-out-of-band-p "tramp-sh")
(declare-function tramp-smb-get-localname "tramp-smb")
(defvar ange-ftp-make-backup-files)
-(defvar auto-save-file-name-transforms)
-(defvar lock-file-name-transforms)
-(defvar remote-file-name-inhibit-locks)
(defvar tramp-connection-properties)
(defvar tramp-copy-size-limit)
(defvar tramp-display-escape-sequence-regexp)
@@ -75,17 +74,93 @@
(defvar tramp-remote-path)
(defvar tramp-remote-process-environment)
-;; Needed for Emacs 25.
-(defvar connection-local-criteria-alist)
-(defvar connection-local-profile-alist)
;; Needed for Emacs 26.
-(defvar async-shell-command-width)
+(declare-function with-connection-local-variables "files-x")
;; Needed for Emacs 27.
+(defvar lock-file-name-transforms)
(defvar process-file-return-signal-string)
+(defvar remote-file-name-inhibit-locks)
(defvar shell-command-dont-erase-buffer)
;; Needed for Emacs 28.
(defvar dired-copy-dereference)
+;; `ert-resource-file' was introduced in Emacs 28.1.
+(unless (macrop 'ert-resource-file)
+ (eval-and-compile
+ (defvar ert-resource-directory-format "%s-resources/"
+ "Format for `ert-resource-directory'.")
+ (defvar ert-resource-directory-trim-left-regexp ""
+ "Regexp for `string-trim' (left) used by `ert-resource-directory'.")
+ (defvar ert-resource-directory-trim-right-regexp
+ (rx (? "-test" (? "s")) ".el")
+ "Regexp for `string-trim' (right) used by `ert-resource-directory'.")
+
+ (defmacro ert-resource-directory ()
+ "Return absolute file name of the resource directory for this file.
+
+The path to the resource directory is the \"resources\" directory
+in the same directory as the test file.
+
+If that directory doesn't exist, use the directory named like the
+test file but formatted by `ert-resource-directory-format' and trimmed
+using `string-trim' with arguments
+`ert-resource-directory-trim-left-regexp' and
+`ert-resource-directory-trim-right-regexp'. The default values mean
+that if called from a test file named \"foo-tests.el\", return
+the absolute file name for \"foo-resources\"."
+ `(let* ((testfile ,(or (bound-and-true-p byte-compile-current-file)
+ (and load-in-progress load-file-name)
+ buffer-file-name))
+ (default-directory (file-name-directory testfile)))
+ (file-truename
+ (if (file-accessible-directory-p "resources/")
+ (expand-file-name "resources/")
+ (expand-file-name
+ (format
+ ert-resource-directory-format
+ (string-trim testfile
+ ert-resource-directory-trim-left-regexp
+ ert-resource-directory-trim-right-regexp)))))))
+
+ (defmacro ert-resource-file (file)
+ "Return file name of resource file named FILE.
+A resource file is in the resource directory as per
+`ert-resource-directory'."
+ `(expand-file-name ,file (ert-resource-directory)))))
+
+;; `ert-remote-temporary-file-directory' was introduced in Emacs 29.1.
+;; Adapting `tramp-remote-path' happens also there.
+(unless (boundp 'ert-remote-temporary-file-directory)
+ (eval-and-compile
+ ;; There is no default value on w32 systems, which could work out
+ ;; of the box.
+ (defconst ert-remote-temporary-file-directory
+ (cond
+ ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY"))
+ ((eq system-type 'windows-nt) null-device)
+ (t (add-to-list
+ 'tramp-methods
+ `("mock"
+ (tramp-login-program ,tramp-default-remote-shell)
+ (tramp-login-args (("-i")))
+ (tramp-direct-async ("-c"))
+ (tramp-remote-shell ,tramp-default-remote-shell)
+ (tramp-remote-shell-args ("-c"))
+ (tramp-connection-timeout 10)))
+ (add-to-list
+ 'tramp-default-host-alist
+ `("\\`mock\\'" nil ,(system-name)))
+ ;; Emacs's Makefile sets $HOME to a nonexistent value.
+ ;; Needed in batch mode only, therefore.
+ (unless (and (null noninteractive) (file-directory-p "~/"))
+ (setenv "HOME" temporary-file-directory))
+ (format "/mock::%s" temporary-file-directory)))
+ "Temporary directory for remote file tests.")
+
+ ;; This should happen on hydra only.
+ (when (getenv "EMACS_HYDRA_CI")
+ (add-to-list 'tramp-remote-path 'tramp-own-remote-path))))
+
;; Beautify batch mode.
(when noninteractive
;; Suppress nasty messages.
@@ -95,32 +170,9 @@
'(fset 'tramp-gvfs-handler-askquestion
(lambda (_message _choices) '(t nil 0)))))
-;; There is no default value on w32 systems, which could work out of the box.
-(defconst tramp-test-temporary-file-directory
- (cond
- ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY"))
- ((eq system-type 'windows-nt) null-device)
- (t (add-to-list
- 'tramp-methods
- '("mock"
- (tramp-login-program "sh")
- (tramp-login-args (("-i")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-args ("-c"))
- (tramp-connection-timeout 10)))
- (add-to-list
- 'tramp-default-host-alist
- `("\\`mock\\'" nil ,(system-name)))
- ;; Emacs's Makefile sets $HOME to a nonexistent value. Needed
- ;; in batch mode only, therefore.
- (unless (and (null noninteractive) (file-directory-p "~/"))
- (setenv "HOME" temporary-file-directory))
- (format "/mock::%s" temporary-file-directory)))
- "Temporary directory for Tramp tests.")
-
(defconst tramp-test-vec
- (and (file-remote-p tramp-test-temporary-file-directory)
- (tramp-dissect-file-name tramp-test-temporary-file-directory))
+ (and (file-remote-p ert-remote-temporary-file-directory)
+ (tramp-dissect-file-name ert-remote-temporary-file-directory))
"The used `tramp-file-name' structure.")
(setq auth-source-save-behavior nil
@@ -129,13 +181,10 @@
tramp-allow-unsafe-temporary-files t
tramp-cache-read-persistent-data t ;; For auth-sources.
tramp-copy-size-limit nil
+ tramp-error-show-message-timeout nil
tramp-persistency-file-name nil
tramp-verbose 0)
-;; This should happen on hydra only.
-(when (getenv "EMACS_HYDRA_CI")
- (add-to-list 'tramp-remote-path 'tramp-own-remote-path))
-
(defvar tramp--test-enabled-checked nil
"Cached result of `tramp--test-enabled'.
If the function did run, the value is a cons cell, the `cdr'
@@ -149,11 +198,19 @@ being the result.")
(cons
t (ignore-errors
(and
- (file-remote-p tramp-test-temporary-file-directory)
- (file-directory-p tramp-test-temporary-file-directory)
- (file-writable-p tramp-test-temporary-file-directory))))))
+ (file-remote-p ert-remote-temporary-file-directory)
+ (file-directory-p ert-remote-temporary-file-directory)
+ (file-writable-p ert-remote-temporary-file-directory))))))
(when (cdr tramp--test-enabled-checked)
+ ;; Remove old test files.
+ (dolist (dir `(,temporary-file-directory
+ ,ert-remote-temporary-file-directory))
+ (dolist (file (directory-files dir 'full (rx bos (? ".#") "tramp-test")))
+ (ignore-errors
+ (if (file-directory-p file)
+ (delete-directory file 'recursive)
+ (delete-file file)))))
;; Cleanup connection.
(ignore-errors
(tramp-cleanup-connection tramp-test-vec nil 'keep-password)))
@@ -170,7 +227,7 @@ The temporary file is not created."
(if quoted #'tramp-compat-file-name-quote #'identity)
(expand-file-name
(make-temp-name "tramp-test")
- (if local temporary-file-directory tramp-test-temporary-file-directory))))
+ (if local temporary-file-directory ert-remote-temporary-file-directory))))
;; Method "smb" supports `make-symbolic-link' only if the remote host
;; has CIFS capabilities. tramp-adb.el, tramp-gvfs.el, tramp-rclone.el
@@ -216,8 +273,7 @@ is greater than 10.
(when (and (null tramp--test-instrument-test-case-p) (> tramp-verbose
3))
(untrace-all)
(dolist (buf (tramp-list-tramp-buffers))
- (with-current-buffer buf
- (message ";; %s\n%s" buf (buffer-string)))
+ (message ";; %s\n%s" buf (tramp-get-buffer-string buf))
(kill-buffer buf))))))
(defsubst tramp--test-message (fmt-string &rest arguments)
@@ -237,8 +293,7 @@ is greater than 10.
(unwind-protect
(progn ,@body)
(tramp--test-message
- "%s %f sec"
- ,message (float-time (time-subtract (current-time) start))))))
+ "%s %f sec" ,message (float-time (time-subtract nil start))))))
;; `always' is introduced with Emacs 28.1.
(defalias 'tramp--test-always
@@ -254,12 +309,12 @@ Also see `ignore'."
"Test availability of Tramp functions."
:expected-result (if (tramp--test-enabled) :passed :failed)
(tramp--test-message
- "Remote directory: `%s'" tramp-test-temporary-file-directory)
+ "Remote directory: `%s'" ert-remote-temporary-file-directory)
(should (ignore-errors
(and
- (file-remote-p tramp-test-temporary-file-directory)
- (file-directory-p tramp-test-temporary-file-directory)
- (file-writable-p tramp-test-temporary-file-directory)))))
+ (file-remote-p ert-remote-temporary-file-directory)
+ (file-directory-p ert-remote-temporary-file-directory)
+ (file-writable-p ert-remote-temporary-file-directory)))))
(ert-deftest tramp-test01-file-name-syntax ()
"Check remote file name syntax."
@@ -334,15 +389,17 @@ Also see `ignore'."
;; `tramp-ignored-file-name-regexp' suppresses Tramp.
(let ((tramp-ignored-file-name-regexp "^/method:user@host:"))
(should-not (tramp-tramp-file-p "/method:user@host:")))
- ;; Methods shall be at least two characters on MS Windows,
- ;; except the default method.
+ ;; Methods shall be at least two characters, except the
+ ;; default method.
(let ((system-type 'windows-nt))
(should-not (tramp-tramp-file-p "/c:/path/to/file"))
(should-not (tramp-tramp-file-p "/c::/path/to/file"))
- (should (tramp-tramp-file-p "/-::/path/to/file")))
+ (should (tramp-tramp-file-p "/-::/path/to/file"))
+ (should (tramp-tramp-file-p "/mm::/path/to/file")))
(let ((system-type 'gnu/linux))
+ (should-not (tramp-tramp-file-p "/m::/path/to/file"))
(should (tramp-tramp-file-p "/-:h:/path/to/file"))
- (should (tramp-tramp-file-p "/m::/path/to/file"))))
+ (should (tramp-tramp-file-p "/mm::/path/to/file"))))
;; Exit.
(tramp-change-syntax syntax))))
@@ -802,8 +859,7 @@ Also see `ignore'."
(string-equal
(file-remote-p
"/method1:user1@host1|method2:user2@host2:/path/to/file")
- (format "/%s:%s@%s|%s:%s@%s:"
- "method1" "user1" "host1" "method2" "user2" "host2")))
+ "/method2:user2@host2:"))
(should
(string-equal
(file-remote-p
@@ -839,10 +895,7 @@ Also see `ignore'."
"/method1:user1@host1"
"|method2:user2@host2"
"|method3:user3@host3:/path/to/file"))
- (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:"
- "method1" "user1" "host1"
- "method2" "user2" "host2"
- "method3" "user3" "host3")))
+ "/method3:user3@host3:"))
(should
(string-equal
(file-remote-p
@@ -901,10 +954,7 @@ Also see `ignore'."
"/-:user1@host1"
"|-:user2@host2"
"|-:user3@host3:/path/to/file"))
- (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:"
- "method1" "user1" "host1"
- "method2" "user2" "host2"
- "method3" "user3" "host3")))
+ "/method3:user3@host3:"))
;; Expand `tramp-default-user-alist'.
(add-to-list 'tramp-default-user-alist '("method1" "host1" "user1"))
@@ -917,10 +967,7 @@ Also see `ignore'."
"/method1:host1"
"|method2:host2"
"|method3:host3:/path/to/file"))
- (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:"
- "method1" "user1" "host1"
- "method2" "user2" "host2"
- "method3" "user3" "host3")))
+ "/method3:user3@host3:"))
;; Expand `tramp-default-host-alist'.
(add-to-list 'tramp-default-host-alist '("method1" "user1" "host1"))
@@ -933,10 +980,7 @@ Also see `ignore'."
"/method1:user1@"
"|method2:user2@"
"|method3:user3@:/path/to/file"))
- (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:"
- "method1" "user1" "host1"
- "method2" "user2" "host2"
- "method3" "user3" "host3")))
+ "/method3:user3@host3:"))
;; Ad-hoc user name and host name expansion.
(setq tramp-default-method-alist nil
@@ -949,10 +993,7 @@ Also see `ignore'."
"/method1:user1@host1"
"|method2:user2@"
"|method3:user3@:/path/to/file"))
- (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s:"
- "method1" "user1" "host1"
- "method2" "user2" "host1"
- "method3" "user3" "host1")))
+ "/method3:user3@host1:"))
(should
(string-equal
(file-remote-p
@@ -961,11 +1002,7 @@ Also see `ignore'."
"|method2:user2@host2"
"|method3:%u@%h"
"|method4:user4%domain4@host4#1234:/path/to/file"))
- (format "/%s:%s@%s|%s:%s@%s|%s:%s@%s|%s:%s@%s:"
- "method1" "user2" "host2"
- "method2" "user2" "host2"
- "method3" "user4" "host4"
- "method4" "user4%domain4" "host4#1234"))))
+ "/method4:user4%domain4@host4#1234:")))
;; Exit.
(tramp-change-syntax syntax))))
@@ -1031,8 +1068,7 @@ Also see `ignore'."
(file-remote-p "/user@email@host:")
(format "/%s@%s:" "user@email" "host")))
(should (string-equal
- (file-remote-p
- "/user@email@host:" 'method) "default-method"))
+ (file-remote-p "/user@email@host:" 'method)
"default-method"))
(should (string-equal
(file-remote-p "/user@email@host:" 'user) "user@email"))
(should (string-equal
@@ -1153,7 +1189,7 @@ Also see `ignore'."
(should
(string-equal
(file-remote-p "/user1@host1|user2@host2:/path/to/file")
- (format "/%s@%s|%s@%s:" "user1" "host1" "user2" "host2")))
+ "/user2@host2:"))
(should
(string-equal
(file-remote-p
@@ -1187,10 +1223,7 @@ Also see `ignore'."
"/user1@host1"
"|user2@host2"
"|user3@host3:/path/to/file"))
- (format "/%s@%s|%s@%s|%s@%s:"
- "user1" "host1"
- "user2" "host2"
- "user3" "host3")))
+ "/user3@host3:"))
(should
(string-equal
(file-remote-p
@@ -1249,10 +1282,7 @@ Also see `ignore'."
"/host1"
"|host2"
"|host3:/path/to/file"))
- (format "/%s@%s|%s@%s|%s@%s:"
- "user1" "host1"
- "user2" "host2"
- "user3" "host3")))
+ "/user3@host3:"))
;; Expand `tramp-default-host-alist'.
(add-to-list 'tramp-default-host-alist '(nil "user1" "host1"))
@@ -1265,10 +1295,7 @@ Also see `ignore'."
"/user1@"
"|user2@"
"|user3@:/path/to/file"))
- (format "/%s@%s|%s@%s|%s@%s:"
- "user1" "host1"
- "user2" "host2"
- "user3" "host3")))
+ "/user3@host3:"))
;; Ad-hoc user name and host name expansion.
(setq tramp-default-user-alist nil
@@ -1280,10 +1307,7 @@ Also see `ignore'."
"/user1@host1"
"|user2@"
"|user3@:/path/to/file"))
- (format "/%s@%s|%s@%s|%s@%s:"
- "user1" "host1"
- "user2" "host1"
- "user3" "host1")))
+ "/user3@host1:"))
(should
(string-equal
(file-remote-p
@@ -1292,11 +1316,7 @@ Also see `ignore'."
"|user2@host2"
"|%u@%h"
"|user4%domain4@host4#1234:/path/to/file"))
- (format "/%s@%s|%s@%s|%s@%s|%s@%s:"
- "user2" "host2"
- "user2" "host2"
- "user4" "host4"
- "user4%domain4" "host4#1234"))))
+ "/user4%domain4@host4#1234:")))
;; Exit.
(tramp-change-syntax syntax))))
@@ -1457,11 +1477,10 @@ Also see `ignore'."
(file-remote-p "/[method/user@email@host]")
(format "/[%s/%s@%s]" "method" "user@email" "host")))
(should (string-equal
- (file-remote-p
- "/[method/user@email@host]" 'method) "method"))
+ (file-remote-p "/[method/user@email@host]" 'method)
"method"))
(should (string-equal
- (file-remote-p
- "/[method/user@email@host]" 'user) "user@email"))
+ (file-remote-p "/[method/user@email@host]" 'user)
+ "user@email"))
(should (string-equal
(file-remote-p "/[method/user@email@host]" 'host) "host"))
(should (string-equal
@@ -1488,11 +1507,10 @@ Also see `ignore'."
(file-remote-p "/[/user@host#1234]")
(format "/[%s/%s@%s]" "default-method" "user" "host#1234")))
(should (string-equal
- (file-remote-p
- "/[/user@host#1234]" 'method) "default-method"))
+ (file-remote-p "/[/user@host#1234]" 'method)
+ "default-method"))
(should (string-equal
- (file-remote-p
- "/[/user@host#1234]" 'user) "user"))
+ (file-remote-p "/[/user@host#1234]" 'user) "user"))
(should (string-equal
(file-remote-p "/[/user@host#1234]" 'host) "host#1234"))
(should (string-equal
@@ -1518,11 +1536,10 @@ Also see `ignore'."
(file-remote-p "/[-/user@host#1234]")
(format "/[%s/%s@%s]" "default-method" "user" "host#1234")))
(should (string-equal
- (file-remote-p
- "/[-/user@host#1234]" 'method) "default-method"))
+ (file-remote-p "/[-/user@host#1234]" 'method)
+ "default-method"))
(should (string-equal
- (file-remote-p
- "/[-/user@host#1234]" 'user) "user"))
+ (file-remote-p "/[-/user@host#1234]" 'user) "user"))
(should (string-equal
(file-remote-p "/[-/user@host#1234]" 'host) "host#1234"))
(should (string-equal
@@ -1552,8 +1569,7 @@ Also see `ignore'."
(should (string-equal
(file-remote-p "/[method/user@host#1234]" 'user) "user"))
(should (string-equal
- (file-remote-p
- "/[method/user@host#1234]" 'host) "host#1234"))
+ (file-remote-p "/[method/user@host#1234]" 'host)
"host#1234"))
(should (string-equal
(file-remote-p "/[method/user@host#1234]" 'localname) ""))
(should (string-equal
@@ -1578,8 +1594,7 @@ Also see `ignore'."
(file-remote-p "/[/user@1.2.3.4]")
(format "/[%s/%s@%s]" "default-method" "user" "1.2.3.4")))
(should (string-equal
- (file-remote-p
- "/[/user@1.2.3.4]" 'method) "default-method"))
+ (file-remote-p "/[/user@1.2.3.4]" 'method) "default-method"))
(should (string-equal
(file-remote-p "/[/user@1.2.3.4]" 'user) "user"))
(should (string-equal
@@ -1607,8 +1622,7 @@ Also see `ignore'."
(file-remote-p "/[-/user@1.2.3.4]")
(format "/[%s/%s@%s]" "default-method" "user" "1.2.3.4")))
(should (string-equal
- (file-remote-p
- "/[-/user@1.2.3.4]" 'method) "default-method"))
+ (file-remote-p "/[-/user@1.2.3.4]" 'method)
"default-method"))
(should (string-equal
(file-remote-p "/[-/user@1.2.3.4]" 'user) "user"))
(should (string-equal
@@ -1792,8 +1806,7 @@ Also see `ignore'."
(string-equal
(file-remote-p
"/[method1/user1@host1|method2/user2@host2]/path/to/file")
- (format "/[%s/%s@%s|%s/%s@%s]"
- "method1" "user1" "host1" "method2" "user2" "host2")))
+ "/[method2/user2@host2]"))
(should
(string-equal
(file-remote-p
@@ -1829,10 +1842,7 @@ Also see `ignore'."
"/[method1/user1@host1"
"|method2/user2@host2"
"|method3/user3@host3]/path/to/file"))
- (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]"
- "method1" "user1" "host1"
- "method2" "user2" "host2"
- "method3" "user3" "host3")))
+ "/[method3/user3@host3]"))
(should
(string-equal
(file-remote-p
@@ -1891,10 +1901,7 @@ Also see `ignore'."
"/[/user1@host1"
"|/user2@host2"
"|/user3@host3]/path/to/file"))
- (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]"
- "method1" "user1" "host1"
- "method2" "user2" "host2"
- "method3" "user3" "host3")))
+ "/[method3/user3@host3]"))
;; Expand `tramp-default-user-alist'.
(add-to-list 'tramp-default-user-alist '("method1" "host1" "user1"))
@@ -1907,10 +1914,7 @@ Also see `ignore'."
"/[method1/host1"
"|method2/host2"
"|method3/host3]/path/to/file"))
- (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]"
- "method1" "user1" "host1"
- "method2" "user2" "host2"
- "method3" "user3" "host3")))
+ "/[method3/user3@host3]"))
;; Expand `tramp-default-host-alist'.
(add-to-list 'tramp-default-host-alist '("method1" "user1" "host1"))
@@ -1923,10 +1927,7 @@ Also see `ignore'."
"/[method1/user1@"
"|method2/user2@"
"|method3/user3@]/path/to/file"))
- (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]"
- "method1" "user1" "host1"
- "method2" "user2" "host2"
- "method3" "user3" "host3")))
+ "/[method3/user3@host3]"))
;; Ad-hoc user name and host name expansion.
(setq tramp-default-method-alist nil
@@ -1939,10 +1940,7 @@ Also see `ignore'."
"/[method1/user1@host1"
"|method2/user2@"
"|method3/user3@]/path/to/file"))
- (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s]"
- "method1" "user1" "host1"
- "method2" "user2" "host1"
- "method3" "user3" "host1")))
+ "/[method3/user3@host1]"))
(should
(string-equal
(file-remote-p
@@ -1951,11 +1949,7 @@ Also see `ignore'."
"|method2/user2@host2"
"|method3/%u@%h"
"|method4/user4%domain4@host4#1234]/path/to/file"))
- (format "/[%s/%s@%s|%s/%s@%s|%s/%s@%s|%s/%s@%s]"
- "method1" "user2" "host2"
- "method2" "user2" "host2"
- "method3" "user4" "host4"
- "method4" "user4%domain4" "host4#1234"))))
+ "/[method4/user4%domain4@host4#1234]")))
;; Exit.
(tramp-change-syntax syntax))))
@@ -2012,7 +2006,7 @@ Also see `ignore'."
(find-file
(format
"%s|%s:foo:"
- (substring (file-remote-p tramp-test-temporary-file-directory) 0 -1)
+ (substring (file-remote-p ert-remote-temporary-file-directory) 0 -1)
m))
:type 'user-error))))
@@ -2067,44 +2061,41 @@ Also see `ignore'."
(substitute-in-file-name "/method:host:/:/path//foo")
"/method:host:/:/path//foo"))
- ;; Forwhatever reasons, the following tests let Emacs crash for
- ;; Emacs 25, occasionally. No idea what's up.
- (when (tramp--test-emacs26-p)
- (should
- (string-equal
- (substitute-in-file-name (concat "/method:host://~" foo))
- (concat "/~" foo)))
- (should
- (string-equal
- (substitute-in-file-name (concat "/method:host:/~" foo))
- (concat "/method:host:/~" foo)))
- (should
- (string-equal
- (substitute-in-file-name (concat "/method:host:/path//~" foo))
- (concat "/~" foo)))
- ;; (substitute-in-file-name "/path/~foo") expands only for a local
- ;; user "foo" to "/~foo"". Otherwise, it doesn't expand.
- (should
- (string-equal
- (substitute-in-file-name (concat "/method:host:/path/~" foo))
- (concat "/method:host:/path/~" foo)))
- ;; Quoting local part.
- (should
- (string-equal
- (substitute-in-file-name (concat "/method:host:/://~" foo))
- (concat "/method:host:/://~" foo)))
- (should
- (string-equal
- (substitute-in-file-name (concat "/method:host:/:/~" foo))
- (concat "/method:host:/:/~" foo)))
- (should
- (string-equal
- (substitute-in-file-name (concat "/method:host:/:/path//~" foo))
- (concat "/method:host:/:/path//~" foo)))
- (should
- (string-equal
- (substitute-in-file-name (concat "/method:host:/:/path/~" foo))
- (concat "/method:host:/:/path/~" foo))))
+ (should
+ (string-equal
+ (substitute-in-file-name (concat "/method:host://~" foo))
+ (concat "/~" foo)))
+ (should
+ (string-equal
+ (substitute-in-file-name (concat "/method:host:/~" foo))
+ (concat "/method:host:/~" foo)))
+ (should
+ (string-equal
+ (substitute-in-file-name (concat "/method:host:/path//~" foo))
+ (concat "/~" foo)))
+ ;; (substitute-in-file-name "/path/~foo") expands only for a local
+ ;; user "foo" to "/~foo"". Otherwise, it doesn't expand.
+ (should
+ (string-equal
+ (substitute-in-file-name (concat "/method:host:/path/~" foo))
+ (concat "/method:host:/path/~" foo)))
+ ;; Quoting local part.
+ (should
+ (string-equal
+ (substitute-in-file-name (concat "/method:host:/://~" foo))
+ (concat "/method:host:/://~" foo)))
+ (should
+ (string-equal
+ (substitute-in-file-name (concat "/method:host:/:/~" foo))
+ (concat "/method:host:/:/~" foo)))
+ (should
+ (string-equal
+ (substitute-in-file-name (concat "/method:host:/:/path//~" foo))
+ (concat "/method:host:/:/path//~" foo)))
+ (should
+ (string-equal
+ (substitute-in-file-name (concat "/method:host:/:/path/~" foo))
+ (concat "/method:host:/:/path/~" foo)))
(let (process-environment)
(should
@@ -2177,25 +2168,25 @@ Also see `ignore'."
(ert-deftest tramp-test05-expand-file-name-relative ()
"Check `expand-file-name'."
(skip-unless (tramp--test-enabled))
- ;; The bugs are fixed in Emacs 28.1.
- (skip-unless (tramp--test-emacs28-p))
;; Methods with a share do not expand "/path/..".
(skip-unless (not (tramp--test-share-p)))
+ ;; The bugs are fixed in Emacs 28.1.
+ (skip-unless (tramp--test-emacs28-p))
(should
(string-equal
(let ((default-directory
(concat
- (file-remote-p tramp-test-temporary-file-directory) "/path")))
+ (file-remote-p ert-remote-temporary-file-directory) "/path")))
(expand-file-name ".." "./"))
- (concat (file-remote-p tramp-test-temporary-file-directory) "/"))))
+ (concat (file-remote-p ert-remote-temporary-file-directory) "/"))))
(ert-deftest tramp-test05-expand-file-name-top ()
"Check `expand-file-name'."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-ange-ftp-p)))
- (let ((dir (concat (file-remote-p tramp-test-temporary-file-directory) "/")))
+ (let ((dir (concat (file-remote-p ert-remote-temporary-file-directory) "/")))
(dolist (local '("." ".."))
(should (string-equal (expand-file-name local dir) dir))
(should (string-equal (expand-file-name (concat dir local)) dir)))))
@@ -2258,8 +2249,8 @@ This checks also `file-name-as-directory',
`file-name-directory',
;; We must clear `tramp-default-method'. On hydra, it is "ftp",
;; which ruins the tests.
(let ((tramp-default-method
- (file-remote-p tramp-test-temporary-file-directory 'method))
- (host (file-remote-p tramp-test-temporary-file-directory 'host)))
+ (file-remote-p ert-remote-temporary-file-directory 'method))
+ (host (file-remote-p ert-remote-temporary-file-directory 'host)))
(dolist
(file
`(,(format "/%s::" tramp-default-method)
@@ -2278,6 +2269,54 @@ This checks also `file-name-as-directory',
`file-name-directory',
(should (string-equal (file-name-directory file) file))
(should (string-equal (file-name-nondirectory file) "")))))))
+(ert-deftest tramp-test07-abbreviate-file-name ()
+ "Check that Tramp abbreviates file names correctly."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (not (tramp--test-ange-ftp-p)))
+ ;; `abbreviate-file-name' is supported since Emacs 29.1.
+ (skip-unless (tramp--test-emacs29-p))
+
+ ;; We must refill the cache. `file-truename' does it.
+ (file-truename ert-remote-temporary-file-directory)
+ (let* ((remote-host (file-remote-p ert-remote-temporary-file-directory))
+ (remote-host-nohop
+ (tramp-make-tramp-file-name (tramp-dissect-file-name remote-host)))
+ ;; Not all methods can expand "~".
+ (home-dir (ignore-errors (expand-file-name (concat remote-host "~"))))
+ home-dir-nohop)
+ (skip-unless home-dir)
+
+ ;; Check home-dir abbreviation.
+ (unless (string-suffix-p "~" home-dir)
+ (should (equal (abbreviate-file-name (concat home-dir "/foo/bar"))
+ (concat remote-host-nohop "~/foo/bar")))
+ (should (equal (abbreviate-file-name
+ (concat remote-host "/nowhere/special"))
+ (concat remote-host-nohop "/nowhere/special"))))
+
+ ;; Check `directory-abbrev-alist' abbreviation.
+ (let ((directory-abbrev-alist
+ `((,(tramp-compat-rx bos (literal home-dir) "/foo")
+ . ,(concat home-dir "/f"))
+ (,(tramp-compat-rx bos (literal remote-host) "/nowhere")
+ . ,(concat remote-host "/nw")))))
+ (should (equal (abbreviate-file-name (concat home-dir "/foo/bar"))
+ (concat remote-host-nohop "~/f/bar")))
+ (should (equal (abbreviate-file-name
+ (concat remote-host "/nowhere/special"))
+ (concat remote-host-nohop "/nw/special"))))
+
+ ;; Check that home-dir abbreviation doesn't occur when home-dir is just
"/".
+ (setq home-dir (concat remote-host "/")
+ home-dir-nohop
+ (tramp-make-tramp-file-name (tramp-dissect-file-name home-dir)))
+ ;; The remote home directory is kept in the connection property "~".
+ ;; We fake this setting.
+ (tramp-set-connection-property tramp-test-vec "~" (file-local-name
home-dir))
+ (should (equal (abbreviate-file-name (concat home-dir "foo/bar"))
+ (concat home-dir-nohop "foo/bar")))
+ (tramp-flush-connection-property tramp-test-vec "~")))
+
(ert-deftest tramp-test07-file-exists-p ()
"Check `file-exist-p', `write-region' and `delete-file'."
(skip-unless (tramp--test-enabled))
@@ -2328,7 +2367,7 @@ This checks also `file-name-as-directory',
`file-name-directory',
(insert-file-contents tmp-name2)
(should (string-equal (buffer-string) "foo")))
;; Check also that a file transfer with compression works.
- (let ((default-directory tramp-test-temporary-file-directory)
+ (let ((default-directory ert-remote-temporary-file-directory)
(tramp-copy-size-limit 4)
(tramp-inline-compress-start-size 2))
(delete-file tmp-name2)
@@ -2338,7 +2377,7 @@ This checks also `file-name-as-directory',
`file-name-directory',
(delete-file tmp-name2)
(should-error
(setq tmp-name2 (file-local-copy tmp-name1))
- :type tramp-file-missing))
+ :type 'file-missing))
;; Cleanup.
(ignore-errors
@@ -2377,7 +2416,7 @@ This checks also `file-name-as-directory',
`file-name-directory',
(delete-file tmp-name)
(should-error
(insert-file-contents tmp-name)
- :type tramp-file-missing))
+ :type 'file-missing))
;; Cleanup.
(ignore-errors (delete-file tmp-name))))))
@@ -2439,6 +2478,19 @@ This checks also `file-name-as-directory',
`file-name-directory',
(insert-file-contents tmp-name)
(should (string-equal (buffer-string) "foo")))
+ ;; Write empty string. Used for creation of temporary files.
+ ;; Since Emacs 27.1.
+ (when (fboundp 'make-empty-file)
+ (with-no-warnings
+ (should-error
+ (make-empty-file tmp-name)
+ :type 'file-already-exists)
+ (delete-file tmp-name)
+ (make-empty-file tmp-name)
+ (with-temp-buffer
+ (insert-file-contents tmp-name)
+ (should (string-equal (buffer-string) "")))))
+
;; Write partly.
(with-temp-buffer
(insert "123456789")
@@ -2448,23 +2500,21 @@ This checks also `file-name-as-directory',
`file-name-directory',
(should (string-equal (buffer-string) "34")))
;; Check message.
- ;; Macro `ert-with-message-capture' was introduced in Emacs 26.1.
- (with-no-warnings (when (symbol-plist 'ert-with-message-capture)
- (let (inhibit-message)
- (dolist
- (noninteractive (unless (tramp--test-ange-ftp-p) '(nil t)))
- (dolist (visit '(nil t "string" no-message))
- (ert-with-message-capture tramp--test-messages
- (write-region "foo" nil tmp-name nil visit)
- ;; We must check the last line. There could be
- ;; other messages from the progress reporter.
- (should
- (string-match-p
- (if (and (null noninteractive)
- (or (eq visit t) (null visit) (stringp visit)))
- (format "^Wrote %s\n\\'" (regexp-quote tmp-name))
- "^\\'")
- tramp--test-messages))))))))
+ (let (inhibit-message)
+ (dolist (noninteractive (unless (tramp--test-ange-ftp-p) '(nil
t)))
+ (dolist (visit '(nil t "string" no-message))
+ (ert-with-message-capture tramp--test-messages
+ (write-region "foo" nil tmp-name nil visit)
+ ;; We must check the last line. There could be
+ ;; other messages from the progress reporter.
+ (should
+ (string-match-p
+ (if (and (null noninteractive)
+ (or (eq visit t) (null visit) (stringp visit)))
+ (tramp-compat-rx
+ bol "Wrote " (literal tmp-name) "\n" eos)
+ (rx bos))
+ tramp--test-messages))))))
;; We do not test lockname here. See
;; `tramp-test39-make-lock-file-name'.
@@ -2474,17 +2524,15 @@ This checks also `file-name-as-directory',
`file-name-directory',
;; Ange-FTP.
((symbol-function 'yes-or-no-p) #'tramp--test-always))
(write-region "foo" nil tmp-name nil nil nil 'mustbenew))
- ;; `mustbenew' is passed to Tramp since Emacs 26.1.
- (when (tramp--test-emacs26-p)
- (should-error
- (cl-letf (((symbol-function #'y-or-n-p) #'ignore)
- ;; Ange-FTP.
- ((symbol-function #'yes-or-no-p) #'ignore))
- (write-region "foo" nil tmp-name nil nil nil 'mustbenew))
- :type 'file-already-exists)
- (should-error
- (write-region "foo" nil tmp-name nil nil nil 'excl)
- :type 'file-already-exists)))
+ (should-error
+ (cl-letf (((symbol-function #'y-or-n-p) #'ignore)
+ ;; Ange-FTP.
+ ((symbol-function #'yes-or-no-p) #'ignore))
+ (write-region "foo" nil tmp-name nil nil nil 'mustbenew))
+ :type 'file-already-exists)
+ (should-error
+ (write-region "foo" nil tmp-name nil nil nil 'excl)
+ :type 'file-already-exists))
;; Cleanup.
(ignore-errors (delete-file tmp-name))))))
@@ -2515,13 +2563,65 @@ This checks also `file-name-as-directory',
`file-name-directory',
(setq-local file-precious-flag t)
(setq-local backup-inhibited t)
(insert "bar")
+ (should (buffer-modified-p))
(should (null (save-buffer)))
+ (should (not (buffer-modified-p)))
(should-not (cl-member tmp-name written-files :test #'string=)))
;; Cleanup.
(ignore-errors (advice-remove 'write-region advice))
(ignore-errors (delete-file tmp-name)))))
+;; The following test is inspired by Bug#55166.
+(ert-deftest tramp-test10-write-region-other-file-name-handler ()
+ "Check that another file name handler in VISIT is acknowledged."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (not (tramp--test-ange-ftp-p)))
+ (skip-unless (executable-find "gzip"))
+ ;; The function was introduced in Emacs 28.1.
+ (skip-unless (boundp 'tar-goto-file))
+
+ (let* ((default-directory ert-remote-temporary-file-directory)
+ (archive (ert-resource-file "foo.tar.gz"))
+ (tmp-file (expand-file-name (file-name-nondirectory archive)))
+ (require-final-newline t)
+ (inhibit-message t)
+ (backup-inhibited t)
+ create-lockfiles buffer1 buffer2)
+ (unwind-protect
+ (progn
+ (copy-file archive tmp-file 'ok)
+ ;; Read archive. Check contents of foo.txt, and modify it. Save.
+ (with-current-buffer (setq buffer1 (find-file-noselect tmp-file))
+ ;; The function was introduced in Emacs 28.1.
+ (with-no-warnings (should (tar-goto-file "foo.txt")))
+ (save-current-buffer
+ (setq buffer2 (tar-extract))
+ (should (string-equal (buffer-string) "foo\n"))
+ (goto-char (point-max))
+ (insert "bar")
+ (should (buffer-modified-p))
+ (should (null (save-buffer)))
+ (should-not (buffer-modified-p)))
+ (should (buffer-modified-p))
+ (should (null (save-buffer)))
+ (should-not (buffer-modified-p)))
+
+ (kill-buffer buffer1)
+ (kill-buffer buffer2)
+ ;; Read archive. Check contents of modified foo.txt.
+ (with-current-buffer (setq buffer1 (find-file-noselect tmp-file))
+ ;; The function was introduced in Emacs 28.1.
+ (with-no-warnings (should (tar-goto-file "foo.txt")))
+ (save-current-buffer
+ (setq buffer2 (tar-extract))
+ (should (string-equal (buffer-string) "foo\nbar\n")))))
+
+ ;; Cleanup.
+ (ignore-errors (kill-buffer buffer1))
+ (ignore-errors (kill-buffer buffer2))
+ (ignore-errors (delete-file tmp-file)))))
+
(ert-deftest tramp-test11-copy-file ()
"Check `copy-file'."
(skip-unless (tramp--test-enabled))
@@ -2548,7 +2648,7 @@ This checks also `file-name-as-directory',
`file-name-directory',
(progn
(should-error
(copy-file source target)
- :type tramp-file-missing)
+ :type 'file-missing)
(write-region "foo" nil source)
(should (file-exists-p source))
(copy-file source target)
@@ -2574,9 +2674,7 @@ This checks also `file-name-as-directory',
`file-name-directory',
(should (file-exists-p source))
(make-directory target)
(should (file-directory-p target))
- ;; This has been changed in Emacs 26.1.
- (when (and (tramp--test-expensive-test-p)
- (tramp--test-emacs26-p))
+ (when (tramp--test-expensive-test-p)
(should-error
(copy-file source target)
:type 'file-already-exists)
@@ -2662,7 +2760,7 @@ This checks also `file-name-as-directory',
`file-name-directory',
(progn
(should-error
(rename-file source target)
- :type tramp-file-missing)
+ :type 'file-missing)
(write-region "foo" nil source)
(should (file-exists-p source))
(rename-file source target)
@@ -2691,9 +2789,7 @@ This checks also `file-name-as-directory',
`file-name-directory',
(should (file-exists-p source))
(make-directory target)
(should (file-directory-p target))
- ;; This has been changed in Emacs 26.1.
- (when (and (tramp--test-expensive-test-p)
- (tramp--test-emacs26-p))
+ (when (tramp--test-expensive-test-p)
(should-error
(rename-file source target)
:type 'file-already-exists)
@@ -2874,7 +2970,7 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(ert-deftest tramp-test15-copy-directory ()
"Check `copy-directory'."
(skip-unless (tramp--test-enabled))
- (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
+ (skip-unless (not (tramp--test-rclone-p)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
@@ -2891,7 +2987,7 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(progn
(should-error
(copy-directory tmp-name1 tmp-name2)
- :type tramp-file-missing)
+ :type 'file-missing)
;; Copy empty directory.
(make-directory tmp-name1)
(write-region "foo" nil tmp-name4)
@@ -2901,11 +2997,9 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(should (file-directory-p tmp-name2))
(should (file-exists-p tmp-name5))
;; Target directory does exist already.
- ;; This has been changed in Emacs 26.1.
- (when (tramp--test-emacs26-p)
- (should-error
- (copy-directory tmp-name1 tmp-name2)
- :type 'file-already-exists))
+ (should-error
+ (copy-directory tmp-name1 tmp-name2)
+ :type 'file-already-exists)
(copy-directory tmp-name1 (file-name-as-directory tmp-name2))
(should (file-directory-p tmp-name3))
(should (file-exists-p tmp-name6)))
@@ -2996,7 +3090,7 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(progn
(should-error
(directory-files tmp-name1)
- :type tramp-file-missing)
+ :type 'file-missing)
(make-directory tmp-name1)
(write-region "foo" nil tmp-name2)
(write-region "bla" nil tmp-name3)
@@ -3119,40 +3213,42 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(with-temp-buffer
(insert-directory tmp-name1 nil)
(goto-char (point-min))
- (should (looking-at-p (regexp-quote tmp-name1))))
- ;; This has been fixed in Emacs 26.1. See Bug#29423.
- (when (tramp--test-emacs26-p)
- (with-temp-buffer
- (insert-directory (file-name-as-directory tmp-name1) nil)
- (goto-char (point-min))
- (should
- (looking-at-p
- (regexp-quote (file-name-as-directory tmp-name1))))))
+ (should (looking-at-p (tramp-compat-rx (literal tmp-name1)))))
+ (with-temp-buffer
+ (insert-directory (file-name-as-directory tmp-name1) nil)
+ (goto-char (point-min))
+ (should
+ (looking-at-p
+ (tramp-compat-rx (literal (file-name-as-directory
tmp-name1))))))
(with-temp-buffer
(insert-directory tmp-name1 "-al")
(goto-char (point-min))
(should
- (looking-at-p (format "^.+ %s$" (regexp-quote tmp-name1)))))
+ (looking-at-p
+ (tramp-compat-rx bol (+ nonl) blank (literal tmp-name1) eol))))
(with-temp-buffer
(insert-directory (file-name-as-directory tmp-name1) "-al")
(goto-char (point-min))
(should
- (looking-at-p (format "^.+ %s/$" (regexp-quote tmp-name1)))))
- (let ((directory-files (directory-files tmp-name1)))
- (with-temp-buffer
- (insert-directory
- (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p)
- (goto-char (point-min))
- (should
- (looking-at-p
- (concat
+ (looking-at-p
+ (tramp-compat-rx
+ bol (+ nonl) blank (literal tmp-name1) "/" eol))))
+ (with-temp-buffer
+ (insert-directory
+ (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p)
+ (goto-char (point-min))
+ (should
+ (looking-at-p
+ (rx-to-string
+ `(:
;; There might be a summary line.
- "\\(total.+[[:digit:]]+ ?[kKMGTPEZY]?i?B?\n\\)?"
+ (? "total" (+ nonl) (+ digit) (? blank)
+ (? (any "EGKMPTYZk")) (? "i") (? "B") "\n")
;; We don't know in which order ".", ".." and "foo" appear.
- (format
- "\\(.+ %s\\( ->.+\\)?\n\\)\\{%d\\}"
- (regexp-opt directory-files)
- (length directory-files)))))))
+ (= ,(length (directory-files tmp-name1))
+ (+ nonl) blank
+ (regexp ,(regexp-opt (directory-files tmp-name1)))
+ (? " ->" (+ nonl)) "\n"))))))
;; Check error cases.
(when (and (tramp--test-supports-set-file-modes-p)
@@ -3160,7 +3256,7 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
;; modes are still "accessible".
(not (tramp--test-sshfs-p))
;; A directory is always accessible for user "root".
- (not (zerop (tramp-compat-file-attribute-user-id
+ (not (zerop (file-attribute-user-id
(file-attributes tmp-name1)))))
(set-file-modes tmp-name1 0)
(with-temp-buffer
@@ -3172,7 +3268,7 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(with-temp-buffer
(should-error
(insert-directory tmp-name1 nil)
- :type tramp-file-missing)))
+ :type 'file-missing)))
;; Cleanup.
(ignore-errors (delete-directory tmp-name1 'recursive))))))
@@ -3180,14 +3276,13 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(ert-deftest tramp-test17-dired-with-wildcards ()
"Check `dired' with wildcards."
;; `separate' syntax and IPv6 host name syntax do not work.
- (skip-unless (not (string-match-p "\\["
tramp-test-temporary-file-directory)))
+ (skip-unless
+ (not (string-match-p (rx "[") ert-remote-temporary-file-directory)))
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
;; Wildcards are not supported in tramp-crypt.el.
(skip-unless (not (tramp--test-crypt-p)))
- ;; Since Emacs 26.1.
- (skip-unless (fboundp 'insert-directory-wildcard-in-dir-p))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1
@@ -3196,10 +3291,10 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(expand-file-name (tramp--test-make-temp-name nil quoted)))
(tmp-name3 (expand-file-name "foo" tmp-name1))
(tmp-name4 (expand-file-name "bar" tmp-name2))
- (tramp-test-temporary-file-directory
+ (ert-remote-temporary-file-directory
(funcall
(if quoted #'tramp-compat-file-name-quote #'identity)
- tramp-test-temporary-file-directory))
+ ert-remote-temporary-file-directory))
buffer)
(unwind-protect
(progn
@@ -3217,19 +3312,21 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(setq buffer
(dired-noselect
(expand-file-name
- "tramp-test*" tramp-test-temporary-file-directory)))
+ "tramp-test*" ert-remote-temporary-file-directory)))
(goto-char (point-min))
(should
(re-search-forward
- (regexp-quote
- (file-relative-name
- tmp-name1 tramp-test-temporary-file-directory))))
+ (tramp-compat-rx
+ (literal
+ (file-relative-name
+ tmp-name1 ert-remote-temporary-file-directory)))))
(goto-char (point-min))
(should
(re-search-forward
- (regexp-quote
- (file-relative-name
- tmp-name2 tramp-test-temporary-file-directory)))))
+ (tramp-compat-rx
+ (literal
+ (file-relative-name
+ tmp-name2 ert-remote-temporary-file-directory))))))
(kill-buffer buffer)
;; Check for expanded directory and file names.
@@ -3237,20 +3334,22 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(setq buffer
(dired-noselect
(expand-file-name
- "tramp-test*/*" tramp-test-temporary-file-directory)))
+ "tramp-test*/*" ert-remote-temporary-file-directory)))
(goto-char (point-min))
(should
(re-search-forward
- (regexp-quote
- (file-relative-name
- tmp-name3 tramp-test-temporary-file-directory))))
+ (tramp-compat-rx
+ (literal
+ (file-relative-name
+ tmp-name3 ert-remote-temporary-file-directory)))))
(goto-char (point-min))
(should
(re-search-forward
- (regexp-quote
- (file-relative-name
- tmp-name4
- tramp-test-temporary-file-directory)))))
+ (tramp-compat-rx
+ (literal
+ (file-relative-name
+ tmp-name4
+ ert-remote-temporary-file-directory))))))
(kill-buffer buffer)
;; Check for special characters.
@@ -3265,20 +3364,22 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(setq buffer
(dired-noselect
(expand-file-name
- "tramp-test*/*" tramp-test-temporary-file-directory)))
+ "tramp-test*/*" ert-remote-temporary-file-directory)))
(goto-char (point-min))
(should
(re-search-forward
- (regexp-quote
- (file-relative-name
- tmp-name3 tramp-test-temporary-file-directory))))
+ (tramp-compat-rx
+ (literal
+ (file-relative-name
+ tmp-name3 ert-remote-temporary-file-directory)))))
(goto-char (point-min))
(should
(re-search-forward
- (regexp-quote
- (file-relative-name
- tmp-name4
- tramp-test-temporary-file-directory)))))
+ (tramp-compat-rx
+ (literal
+ (file-relative-name
+ tmp-name4
+ ert-remote-temporary-file-directory))))))
(kill-buffer buffer))
;; Cleanup.
@@ -3316,7 +3417,7 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(goto-char (point-min))
(while (not (or (eobp)
(string-equal
- (dired-get-filename 'localp 'no-error)
+ (dired-get-filename 'no-dir 'no-error)
(file-name-nondirectory tmp-name2))))
(forward-line 1))
(should-not (eobp))
@@ -3326,14 +3427,14 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
;; Point shall still be the recent file.
(should
(string-equal
- (dired-get-filename 'localp 'no-error)
+ (dired-get-filename 'no-dir 'no-error)
(file-name-nondirectory tmp-name2)))
- (should-not (re-search-forward "dired" nil t))
+ (should-not (search-forward "dired" nil t))
;; The copied file has been inserted the line before.
(forward-line -1)
(should
(string-equal
- (dired-get-filename 'localp 'no-error)
+ (dired-get-filename 'no-dir 'no-error)
(file-name-nondirectory tmp-name3))))
(kill-buffer buffer))
@@ -3351,8 +3452,8 @@ This tests also `access-file', `file-readable-p',
;; We must use `file-truename' for the temporary directory,
;; because it could be located on a symlinked directory. This
;; would let the test fail.
- (let* ((tramp-test-temporary-file-directory
- (file-truename tramp-test-temporary-file-directory))
+ (let* ((ert-remote-temporary-file-directory
+ (file-truename ert-remote-temporary-file-directory))
(tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
;; File name with "//".
@@ -3372,28 +3473,27 @@ This tests also `access-file', `file-readable-p',
(and test-file-ownership-preserved-p
(zerop (logand
#o1000
- (file-modes tramp-test-temporary-file-directory))))
+ (file-modes ert-remote-temporary-file-directory))))
(write-region "foo" nil tmp-name1)
(setq test-file-ownership-preserved-p
- (= (tramp-compat-file-attribute-group-id
- (file-attributes tmp-name1))
+ (= (file-attribute-group-id (file-attributes tmp-name1))
(tramp-get-remote-gid tramp-test-vec 'integer)))
(delete-file tmp-name1))
(when (tramp--test-supports-set-file-modes-p)
(write-region "foo" nil tmp-name1)
;; A file is always accessible for user "root".
- (when (not (zerop (tramp-compat-file-attribute-user-id
- (file-attributes tmp-name1))))
+ (unless
+ (zerop (file-attribute-user-id (file-attributes tmp-name1)))
(set-file-modes tmp-name1 0)
(should-error
(access-file tmp-name1 "error")
- :type 'file-error)
+ :type tramp-permission-denied)
(set-file-modes tmp-name1 #o777))
(delete-file tmp-name1))
(should-error
(access-file tmp-name1 "error")
- :type tramp-file-missing)
+ :type 'file-missing)
;; `file-ownership-preserved-p' should return t for
;; non-existing files.
@@ -3410,33 +3510,29 @@ This tests also `access-file', `file-readable-p',
;; We do not test inodes and device numbers.
(setq attr (file-attributes tmp-name1))
(should (consp attr))
- (should (null (tramp-compat-file-attribute-type attr)))
- (should (numberp (tramp-compat-file-attribute-link-number attr)))
- (should (numberp (tramp-compat-file-attribute-user-id attr)))
- (should (numberp (tramp-compat-file-attribute-group-id attr)))
+ (should (null (file-attribute-type attr)))
+ (should (numberp (file-attribute-link-number attr)))
+ (should (numberp (file-attribute-user-id attr)))
+ (should (numberp (file-attribute-group-id attr)))
(should
- (stringp
- (current-time-string
- (tramp-compat-file-attribute-access-time attr))))
+ (stringp (current-time-string (file-attribute-access-time attr))))
(should
(stringp
- (current-time-string
- (tramp-compat-file-attribute-modification-time attr))))
+ (current-time-string (file-attribute-modification-time attr))))
(should
(stringp
- (current-time-string
- (tramp-compat-file-attribute-status-change-time attr))))
- (should (numberp (tramp-compat-file-attribute-size attr)))
- (should (stringp (tramp-compat-file-attribute-modes attr)))
+ (current-time-string (file-attribute-status-change-time attr))))
+ (should (numberp (file-attribute-size attr)))
+ (should (stringp (file-attribute-modes attr)))
(setq attr (file-attributes tmp-name1 'string))
- (should (stringp (tramp-compat-file-attribute-user-id attr)))
- (should (stringp (tramp-compat-file-attribute-group-id attr)))
+ (should (stringp (file-attribute-user-id attr)))
+ (should (stringp (file-attribute-group-id attr)))
(tramp--test-ignore-make-symbolic-link-error
(should-error
(access-file tmp-name2 "error")
- :type tramp-file-missing)
+ :type 'file-missing)
(when test-file-ownership-preserved-p
(should (file-ownership-preserved-p tmp-name2 'group)))
(make-symbolic-link tmp-name1 tmp-name2)
@@ -3450,13 +3546,13 @@ This tests also `access-file', `file-readable-p',
(string-equal
(funcall
(if quoted #'tramp-compat-file-name-quote #'identity)
- (tramp-compat-file-attribute-type attr))
+ (file-attribute-type attr))
(file-remote-p (file-truename tmp-name1) 'localname)))
(delete-file tmp-name2))
;; Check, that "//" in symlinks are handled properly.
(with-temp-buffer
- (let ((default-directory tramp-test-temporary-file-directory))
+ (let ((default-directory ert-remote-temporary-file-directory))
(shell-command
(format
"ln -s %s %s"
@@ -3469,7 +3565,7 @@ This tests also `access-file', `file-readable-p',
(setq attr (file-attributes tmp-name2))
(should
(string-equal
- (tramp-compat-file-attribute-type attr)
+ (file-attribute-type attr)
(funcall
(if (tramp--test-sshfs-p) #'file-name-nondirectory #'identity)
(tramp-file-name-localname
@@ -3487,13 +3583,105 @@ This tests also `access-file', `file-readable-p',
(when test-file-ownership-preserved-p
(should (file-ownership-preserved-p tmp-name1 'group)))
(setq attr (file-attributes tmp-name1))
- (should (eq (tramp-compat-file-attribute-type attr) t)))
+ (should (eq (file-attribute-type attr) t)))
;; Cleanup.
(ignore-errors (delete-directory tmp-name1))
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name2))))))
+(defmacro tramp--test-deftest-with-stat (test)
+ "Define ert `TEST-with-stat'."
+ (declare (indent 1))
+ `(ert-deftest ,(intern (concat (symbol-name test) "-with-stat")) ()
+ ;; This is the docstring. However, it must be expanded to a
+ ;; string inside the macro. No idea.
+ ;; (concat (ert-test-documentation (get ',test 'ert--test))
+ ;; "\nUse the \"stat\" command.")
+ :tags '(:expensive-test)
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (tramp--test-sh-p))
+ (skip-unless (tramp-get-remote-stat tramp-test-vec))
+ (if-let ((default-directory ert-remote-temporary-file-directory)
+ (ert-test (ert-get-test ',test))
+ (result (ert-test-most-recent-result ert-test))
+ (tramp-connection-properties
+ (cons '(nil "perl" nil)
+ tramp-connection-properties)))
+ (progn
+ ;; `ert-test-result-duration' exists since Emacs 27. It
+ ;; doesn't hurt to call it unconditionally, because
+ ;; `skip-unless' hides the error.
+ (skip-unless (< (ert-test-result-duration result) 300))
+ (funcall (ert-test-body ert-test)))
+ (ert-skip (format "Test `%s' must run before" ',test)))))
+
+(defmacro tramp--test-deftest-with-perl (test)
+ "Define ert `TEST-with-perl'."
+ (declare (indent 1))
+ `(ert-deftest ,(intern (concat (symbol-name test) "-with-perl")) ()
+ ;; This is the docstring. However, it must be expanded to a
+ ;; string inside the macro. No idea.
+ ;; (concat (ert-test-documentation (get ',test 'ert--test))
+ ;; "\nUse the \"perl\" command.")
+ :tags '(:expensive-test)
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (tramp--test-sh-p))
+ (skip-unless (tramp-get-remote-perl tramp-test-vec))
+ (if-let ((default-directory ert-remote-temporary-file-directory)
+ (ert-test (ert-get-test ',test))
+ (result (ert-test-most-recent-result ert-test))
+ (tramp-connection-properties
+ (append
+ '((nil "stat" nil)
+ ;; See `tramp-sh-handle-file-truename'.
+ (nil "readlink" nil)
+ ;; See `tramp-sh-handle-get-remote-*'.
+ (nil "id" nil))
+ tramp-connection-properties)))
+ (progn
+ ;; `ert-test-result-duration' exists since Emacs 27. It
+ ;; doesn't hurt to call it unconditionally, because
+ ;; `skip-unless' hides the error.
+ (skip-unless (< (ert-test-result-duration result) 300))
+ (funcall (ert-test-body ert-test)))
+ (ert-skip (format "Test `%s' must run before" ',test)))))
+
+(defmacro tramp--test-deftest-with-ls (test)
+ "Define ert `TEST-with-ls'."
+ (declare (indent 1))
+ `(ert-deftest ,(intern (concat (symbol-name test) "-with-ls")) ()
+ ;; This is the docstring. However, it must be expanded to a
+ ;; string inside the macro. No idea.
+ ;; (concat (ert-test-documentation (get ',test 'ert--test))
+ ;; "\nUse the \"ls\" command.")
+ :tags '(:expensive-test)
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (tramp--test-sh-p))
+ (if-let ((default-directory ert-remote-temporary-file-directory)
+ (ert-test (ert-get-test ',test))
+ (result (ert-test-most-recent-result ert-test))
+ (tramp-connection-properties
+ (append
+ '((nil "perl" nil)
+ (nil "stat" nil)
+ ;; See `tramp-sh-handle-file-truename'.
+ (nil "readlink" nil))
+ tramp-connection-properties)))
+ (progn
+ ;; `ert-test-result-duration' exists since Emacs 27. It
+ ;; doesn't hurt to call it unconditionally, because
+ ;; `skip-unless' hides the error.
+ (skip-unless (< (ert-test-result-duration result) 300))
+ (funcall (ert-test-body ert-test)))
+ (ert-skip (format "Test `%s' must run before" ',test)))))
+
+(tramp--test-deftest-with-stat tramp-test18-file-attributes)
+
+(tramp--test-deftest-with-perl tramp-test18-file-attributes)
+
+(tramp--test-deftest-with-ls tramp-test18-file-attributes)
+
(defvar tramp--test-start-time nil
"Keep the start time of the current test, a float number.")
@@ -3505,9 +3693,9 @@ They might differ only in time attributes or directory
size."
(start-time (- tramp--test-start-time 10)))
;; Link number. For directories, it includes the number of
;; subdirectories. Set it to 1.
- (when (eq (tramp-compat-file-attribute-type attr1) t)
+ (when (eq (file-attribute-type attr1) t)
(setcar (nthcdr 1 attr1) 1))
- (when (eq (tramp-compat-file-attribute-type attr2) t)
+ (when (eq (file-attribute-type attr2) t)
(setcar (nthcdr 1 attr2) 1))
;; Access time.
(setcar (nthcdr 4 attr1) tramp-time-dont-know)
@@ -3520,42 +3708,33 @@ They might differ only in time attributes or directory
size."
;; order to compensate a possible timestamp resolution higher than
;; a second on the remote machine.
(when (or (tramp-compat-time-equal-p
- (tramp-compat-file-attribute-modification-time attr1)
- tramp-time-dont-know)
+ (file-attribute-modification-time attr1) tramp-time-dont-know)
(tramp-compat-time-equal-p
- (tramp-compat-file-attribute-modification-time attr2)
- tramp-time-dont-know))
+ (file-attribute-modification-time attr2) tramp-time-dont-know))
(setcar (nthcdr 5 attr1) tramp-time-dont-know)
(setcar (nthcdr 5 attr2) tramp-time-dont-know))
(when (< start-time
- (float-time (tramp-compat-file-attribute-modification-time attr1)))
+ (float-time (file-attribute-modification-time attr1)))
(setcar (nthcdr 5 attr1) tramp-time-dont-know))
(when (< start-time
- (float-time (tramp-compat-file-attribute-modification-time attr2)))
+ (float-time (file-attribute-modification-time attr2)))
(setcar (nthcdr 5 attr2) tramp-time-dont-know))
;; Status change time. Ditto.
(when (or (tramp-compat-time-equal-p
- (tramp-compat-file-attribute-status-change-time attr1)
- tramp-time-dont-know)
+ (file-attribute-status-change-time attr1) tramp-time-dont-know)
(tramp-compat-time-equal-p
- (tramp-compat-file-attribute-status-change-time attr2)
- tramp-time-dont-know))
+ (file-attribute-status-change-time attr2) tramp-time-dont-know))
(setcar (nthcdr 6 attr1) tramp-time-dont-know)
(setcar (nthcdr 6 attr2) tramp-time-dont-know))
- (when
- (< start-time
- (float-time
- (tramp-compat-file-attribute-status-change-time attr1)))
+ (when (< start-time (float-time (file-attribute-status-change-time attr1)))
(setcar (nthcdr 6 attr1) tramp-time-dont-know))
- (when
- (< start-time
- (float-time (tramp-compat-file-attribute-status-change-time attr2)))
+ (when (< start-time (float-time (file-attribute-status-change-time attr2)))
(setcar (nthcdr 6 attr2) tramp-time-dont-know))
;; Size. Set it to 0 for directories, because it might have
;; changed. For example the upper directory "../".
- (when (eq (tramp-compat-file-attribute-type attr1) t)
+ (when (eq (file-attribute-type attr1) t)
(setcar (nthcdr 7 attr1) 0))
- (when (eq (tramp-compat-file-attribute-type attr2) t)
+ (when (eq (file-attribute-type attr2) t)
(setcar (nthcdr 7 attr2) 0))
;; The check.
(unless (equal attr1 attr2) (tramp--test-message "%S\n%S" attr1 attr2))
@@ -3579,12 +3758,12 @@ They might differ only in time attributes or directory
size."
(progn
(should-error
(directory-files-and-attributes tmp-name1)
- :type tramp-file-missing)
+ :type 'file-missing)
(make-directory tmp-name1)
(should (file-directory-p tmp-name1))
(setq tramp--test-start-time
(float-time
- (tramp-compat-file-attribute-modification-time
+ (file-attribute-modification-time
(file-attributes tmp-name1))))
(make-directory tmp-name2)
(should (file-directory-p tmp-name2))
@@ -3607,19 +3786,26 @@ They might differ only in time attributes or directory
size."
(tramp--test-file-attributes-equal-p
(file-attributes (car elt)) (cdr elt))))
- (setq attr (directory-files-and-attributes tmp-name2 nil "\\`b"))
+ (setq attr (directory-files-and-attributes
+ tmp-name2 nil (rx bos "b")))
(should (equal (mapcar #'car attr) '("bar" "boz")))
;; Check the COUNT arg. It exists since Emacs 28.
(when (tramp--test-emacs28-p)
(with-no-warnings
(setq attr (directory-files-and-attributes
- tmp-name2 nil "\\`b" nil nil 1))
+ tmp-name2 nil (rx bos "b") nil nil 1))
(should (equal (mapcar #'car attr) '("bar"))))))
;; Cleanup.
(ignore-errors (delete-directory tmp-name1 'recursive))))))
+(tramp--test-deftest-with-stat tramp-test19-directory-files-and-attributes)
+
+(tramp--test-deftest-with-perl tramp-test19-directory-files-and-attributes)
+
+(tramp--test-deftest-with-ls tramp-test19-directory-files-and-attributes)
+
(ert-deftest tramp-test20-file-modes ()
"Check `file-modes'.
This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
@@ -3642,16 +3828,20 @@ This tests also `file-executable-p', `file-writable-p'
and `set-file-modes'."
(should (= (file-modes tmp-name1) #o444))
(should-not (file-executable-p tmp-name1))
;; A file is always writable for user "root".
- (unless (or (zerop (tramp-compat-file-attribute-user-id
- (file-attributes tmp-name1)))
- (tramp--test-sshfs-p))
+ (unless
+ (or (zerop (file-attribute-user-id (file-attributes tmp-name1)))
+ (tramp--test-sshfs-p))
(should-not (file-writable-p tmp-name1)))
;; Check the NOFOLLOW arg. It exists since Emacs 28. For
;; regular files, there shouldn't be a difference.
(when (tramp--test-emacs28-p)
(with-no-warnings
(set-file-modes tmp-name1 #o222 'nofollow)
- (should (= (file-modes tmp-name1 'nofollow) #o222)))))
+ (should (= (file-modes tmp-name1 'nofollow) #o222))))
+ ;; Setting the mode for not existing files shall fail.
+ (should-error
+ (set-file-modes tmp-name2 #o777)
+ :type 'file-missing))
;; Cleanup.
(ignore-errors (delete-file tmp-name1)))
@@ -3710,24 +3900,21 @@ This tests also `file-executable-p', `file-writable-p'
and `set-file-modes'."
`(condition-case err
(progn ,@body)
(file-error
- (unless (string-match-p "^error with add-name-to-file"
- (error-message-string err))
+ (unless (string-prefix-p "error with add-name-to-file"
+ (error-message-string err))
(signal (car err) (cdr err))))))
(ert-deftest tramp-test21-file-links ()
"Check `file-symlink-p'.
This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(skip-unless (tramp--test-enabled))
- ;; The semantics have changed heavily in Emacs 26.1. We cannot test
- ;; older Emacsen, therefore.
- (skip-unless (tramp--test-emacs26-p))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
;; We must use `file-truename' for the temporary directory,
;; because it could be located on a symlinked directory. This
;; would let the test fail.
- (let* ((tramp-test-temporary-file-directory
- (file-truename tramp-test-temporary-file-directory))
+ (let* ((ert-remote-temporary-file-directory
+ (file-truename ert-remote-temporary-file-directory))
(tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted))
@@ -3874,7 +4061,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(should (file-equal-p tmp-name1 tmp-name2))
;; Check relative symlink file name.
(delete-file tmp-name2)
- (let ((default-directory tramp-test-temporary-file-directory))
+ (let ((default-directory ert-remote-temporary-file-directory))
(make-symbolic-link (file-name-nondirectory tmp-name1) tmp-name2))
(should (file-symlink-p tmp-name2))
(should-not (string-equal tmp-name2 (file-truename tmp-name2)))
@@ -3921,7 +4108,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(tramp--test-ignore-make-symbolic-link-error
(make-directory tmp-name1)
(should (file-directory-p tmp-name1))
- (let* ((tramp-test-temporary-file-directory
+ (let* ((ert-remote-temporary-file-directory
(file-truename tmp-name1))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 tmp-name2)
@@ -3937,11 +4124,11 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(when (tramp--test-expensive-test-p)
(should-error
(with-temp-buffer (insert-file-contents tmp-name2))
- :type tramp-file-missing))
+ :type 'file-missing))
(when (tramp--test-expensive-test-p)
(should-error
(with-temp-buffer (insert-file-contents tmp-name3))
- :type tramp-file-missing))
+ :type 'file-missing))
;; `directory-files' does not show symlinks to
;; non-existing targets in the "smb" case. So we remove
;; the symlinks manually.
@@ -3950,9 +4137,9 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(setq tmp-name3 (concat (file-remote-p tmp-name3) tmp-name2)))))
;; Cleanup.
- (ignore-errors
- (delete-file tmp-name3)
- (delete-directory tmp-name1 'recursive)))
+ (ignore-errors (delete-file tmp-name2))
+ (ignore-errors (delete-file tmp-name3))
+ (ignore-errors (delete-directory tmp-name1 'recursive)))
;; Detect cyclic symbolic links.
(unwind-protect
@@ -3982,7 +4169,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(directory-file-name
(funcall
(if quoted #'tramp-compat-file-name-quote #'identity)
- tramp-test-temporary-file-directory)))
+ ert-remote-temporary-file-directory)))
(dir2 (file-name-as-directory dir1)))
(should (string-equal (file-truename dir1) (expand-file-name dir1)))
(should (string-equal (file-truename dir2) (expand-file-name dir2)))))))
@@ -4002,7 +4189,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(progn
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
- (should (consp (tramp-compat-file-attribute-modification-time
+ (should (consp (file-attribute-modification-time
(file-attributes tmp-name1))))
;; Skip the test, if the remote handler is not able to set
;; the correct time.
@@ -4011,14 +4198,17 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
;; Dumb remote shells without perl(1) or stat(1) are not
;; able to return the date correctly. They say "don't know".
(unless (tramp-compat-time-equal-p
- (tramp-compat-file-attribute-modification-time
+ (file-attribute-modification-time
(file-attributes tmp-name1))
tramp-time-dont-know)
(should
(tramp-compat-time-equal-p
- (tramp-compat-file-attribute-modification-time
- (file-attributes tmp-name1))
+ (file-attribute-modification-time (file-attributes tmp-name1))
(seconds-to-time 60)))
+ ;; Setting the time for not existing files shall fail.
+ (should-error
+ (set-file-times tmp-name2)
+ :type 'file-missing)
(write-region "bla" nil tmp-name2)
(should (file-exists-p tmp-name2))
(should (file-newer-than-file-p tmp-name2 tmp-name1))
@@ -4032,7 +4222,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(set-file-times tmp-name1 (seconds-to-time 60) 'nofollow)
(should
(tramp-compat-time-equal-p
- (tramp-compat-file-attribute-modification-time
+ (file-attribute-modification-time
(file-attributes tmp-name1))
(seconds-to-time 60)))))))
@@ -4074,7 +4264,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
"Check that `file-acl' and `set-file-acl' work proper."
(skip-unless (tramp--test-enabled))
;; The following test checks also whether `set-file-modes' will work.
- (skip-unless (file-acl tramp-test-temporary-file-directory))
+ (skip-unless (file-acl ert-remote-temporary-file-directory))
(skip-unless (not (tramp--test-crypt-p)))
;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
@@ -4095,7 +4285,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(should (file-acl tmp-name2))
(should (string-equal (file-acl tmp-name1) (file-acl tmp-name2)))
;; Different permissions mean different ACLs.
- (when (not (tramp--test-windows-nt-or-smb-p))
+ (unless (tramp--test-windows-nt-or-smb-p)
(set-file-modes tmp-name1 #o777)
(set-file-modes tmp-name2 #o444)
(should-not
@@ -4153,7 +4343,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
"Check `file-selinux-context' and `set-file-selinux-context'."
(skip-unless (tramp--test-enabled))
(skip-unless
- (not (equal (file-selinux-context tramp-test-temporary-file-directory)
+ (not (equal (file-selinux-context ert-remote-temporary-file-directory)
'(nil nil nil nil))))
(skip-unless (not (tramp--test-crypt-p)))
@@ -4214,7 +4404,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(let ((default-directory temporary-file-directory))
(shell-command-to-string "id -Z"))
(let ((default-directory
- tramp-test-temporary-file-directory))
+ ert-remote-temporary-file-directory))
(shell-command-to-string "id -Z"))))
;; Two files with same SELinux context.
@@ -4297,10 +4487,10 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
;; Method and host name in completion mode. This kind of completion
;; does not work on MS Windows.
- (when (not (memq system-type '(cygwin windows-nt)))
+ (unless (memq system-type '(cygwin windows-nt))
(let ((tramp-fuse-remove-hidden-files t)
- (method (file-remote-p tramp-test-temporary-file-directory 'method))
- (host (file-remote-p tramp-test-temporary-file-directory 'host))
+ (method (file-remote-p ert-remote-temporary-file-directory 'method))
+ (host (file-remote-p ert-remote-temporary-file-directory 'host))
(orig-syntax tramp-syntax))
(when (and (stringp host) (string-match tramp-host-with-port-regexp
host))
(setq host (match-string 1 host)))
@@ -4427,10 +4617,13 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(load tmp-name 'noerror 'nomessage))
(should-not (featurep 'tramp-test-load))
(write-region "(provide 'tramp-test-load)" nil tmp-name)
- ;; `load' in lread.c does not pass `must-suffix'. Why?
- ;;(should-error
- ;; (load tmp-name nil 'nomessage 'nosuffix 'must-suffix)
- ;; :type 'file-error)
+ ;; `load' in lread.c passes `must-suffix' since Emacs 29.
+ ;; In Ange-FTP, `must-suffix' is ignored.
+ (when (and (tramp--test-emacs29-p)
+ (not (tramp--test-ange-ftp-p)))
+ (should-error
+ (load tmp-name nil 'nomessage 'nosuffix 'must-suffix)
+ :type 'file-error))
(load tmp-name nil 'nomessage 'nosuffix)
(should (featurep 'tramp-test-load)))
@@ -4443,7 +4636,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
"Return default remote shell."
(if (file-exists-p
(concat
- (file-remote-p tramp-test-temporary-file-directory) "/system/bin/sh"))
+ (file-remote-p ert-remote-temporary-file-directory) "/system/bin/sh"))
"/system/bin/sh" "/bin/sh"))
(ert-deftest tramp-test28-process-file ()
@@ -4455,7 +4648,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name (tramp--test-make-temp-name nil quoted))
(fnnd (file-name-nondirectory tmp-name))
- (default-directory tramp-test-temporary-file-directory)
+ (default-directory ert-remote-temporary-file-directory)
(buffer (get-buffer-create "*tramp-tests*"))
kill-buffer-query-functions)
(unwind-protect
@@ -4484,7 +4677,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(let ((process-file-return-signal-string t))
(should
(string-match-p
- "Interrupt\\|Signal 2"
+ (rx (| "Interrupt" "Signal 2"))
(process-file
(tramp--test-shell-file-name)
nil nil nil "-c" "kill -2 $$")))))
@@ -4564,7 +4757,8 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(insert-file-contents tmp-name)
(should
(string-match-p
- "cat:.* No such file or directory" (buffer-string)))
+ (rx "cat:" (* nonl) " No such file or directory")
+ (buffer-string)))
(should-not (get-buffer-window (current-buffer) t))
(delete-file tmp-name))))
@@ -4589,16 +4783,19 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(skip-unless (tramp--test-supports-processes-p))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
- (let ((default-directory tramp-test-temporary-file-directory)
+ (let ((default-directory ert-remote-temporary-file-directory)
(tmp-name (tramp--test-make-temp-name nil quoted))
- kill-buffer-query-functions proc)
+ kill-buffer-query-functions command proc)
;; Simple process.
(unwind-protect
(with-temp-buffer
- (setq proc (start-file-process "test1" (current-buffer) "cat"))
+ (setq command '("cat")
+ proc
+ (apply #'start-file-process "test1" (current-buffer) command))
(should (processp proc))
(should (equal (process-status proc) 'run))
+ (should (equal (process-get proc 'remote-command) command))
(process-send-string proc "foo\n")
(process-send-eof proc)
;; Read output.
@@ -4615,11 +4812,11 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(with-temp-buffer
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
- (setq proc
- (start-file-process
- "test2" (current-buffer)
- "cat" (file-name-nondirectory tmp-name)))
+ (setq command `("cat" ,(file-name-nondirectory tmp-name))
+ proc
+ (apply #'start-file-process "test2" (current-buffer) command))
(should (processp proc))
+ (should (equal (process-get proc 'remote-command) command))
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
@@ -4634,9 +4831,12 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
;; Process filter.
(unwind-protect
(with-temp-buffer
- (setq proc (start-file-process "test3" (current-buffer) "cat"))
+ (setq command '("cat")
+ proc
+ (apply #'start-file-process "test3" (current-buffer) command))
(should (processp proc))
(should (equal (process-status proc) 'run))
+ (should (equal (process-get proc 'remote-command) command))
(set-process-filter
proc
(lambda (p s) (with-current-buffer (process-buffer p) (insert s))))
@@ -4655,9 +4855,12 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(unless (tramp--test-sshfs-p)
(unwind-protect
(with-temp-buffer
- (setq proc (start-file-process "test3" (current-buffer) "cat"))
+ (setq command '("cat")
+ proc
+ (apply #'start-file-process "test4" (current-buffer) command))
(should (processp proc))
(should (equal (process-status proc) 'run))
+ (should (equal (process-get proc 'remote-command) command))
(set-process-filter proc t)
(process-send-string proc "foo\n")
(process-send-eof proc)
@@ -4683,12 +4886,14 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(dolist (process-connection-type '(nil pipe t pty))
(unwind-protect
(with-temp-buffer
- (setq proc
- (start-file-process
- (format "test4-%s" process-connection-type)
- (current-buffer) "hexdump" "-v" "-e" "/1 \"%02X\n\""))
+ (setq command '("hexdump" "-v" "-e" "/1 \"%02X\n\"")
+ proc
+ (apply #'start-file-process
+ (format "test5-%s" process-connection-type)
+ (current-buffer) command))
(should (processp proc))
(should (equal (process-status proc) 'run))
+ (should (equal (process-get proc 'remote-command) command))
(process-send-string proc "foo\r\n")
(process-send-eof proc)
;; Read output.
@@ -4703,8 +4908,8 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
;; On macOS, there is always newline conversion.
;; "telnet" converts \r to <CR><NUL> if `crlf'
;; flag is FALSE. See telnet(1) man page.
- "66\n6F\n6F\n0D\\(\n00\\)?\n0A\n"
- "66\n6F\n6F\n0A\\(\n00\\)?\n0A\n")
+ (rx "66\n6F\n6F\n0D" (? "\n00") "\n0A\n")
+ (rx "66\n6F\n6F\n0A" (? "\n00") "\n0A\n"))
(buffer-string))))
;; Cleanup.
@@ -4716,12 +4921,13 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
;; It works only for tramp-sh.el, and not direct async processes.
(if (or (not (tramp--test-sh-p)) (tramp-direct-async-process-p))
(should-error
- (start-file-process "test5" (current-buffer) nil)
+ (start-file-process "test6" (current-buffer) nil)
:type 'wrong-type-argument)
- (setq proc (start-file-process "test5" (current-buffer) nil))
+ (setq proc (start-file-process "test6" (current-buffer) nil))
(should (processp proc))
(should (equal (process-status proc) 'run))
+ (should-not (process-get proc 'remote-command))
;; On MS Windows, `process-tty-name' returns nil.
(unless (tramp--test-windows-nt-p)
(should (stringp (process-tty-name proc))))))
@@ -4729,8 +4935,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
;; Cleanup.
(ignore-errors (delete-process proc))))))
-(defmacro tramp--test--deftest-direct-async-process
- (test docstring &optional unstable)
+(defmacro tramp--test-deftest-direct-async-process (test &optional unstable)
"Define ert test `TEST-direct-async' for direct async processes.
If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(declare (indent 1))
@@ -4739,11 +4944,14 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(when (let ((file-name-handler-alist '(("" . (lambda (&rest _) t)))))
(ignore-errors (make-process :file-handler t)))
`(ert-deftest ,(intern (concat (symbol-name test) "-direct-async")) ()
- ,docstring
+ ;; This is the docstring. However, it must be expanded to a
+ ;; string inside the macro. No idea.
+ ;; (concat (ert-test-documentation (get ',test 'ert--test))
+ ;; "\nUse direct async process.")
:tags (append '(:expensive-test :tramp-asynchronous-processes)
(and ,unstable '(:unstable)))
(skip-unless (tramp--test-enabled))
- (let ((default-directory tramp-test-temporary-file-directory)
+ (let ((default-directory ert-remote-temporary-file-directory)
(ert-test (ert-get-test ',test))
(tramp-connection-properties
(cons '(nil "direct-async-process" t)
@@ -4756,11 +4964,10 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(cl-letf (((symbol-function #'tramp--test-enabled)
#'tramp--test-always)
((symbol-function #'internal-default-process-sentinel)
#'ignore))
- (file-truename tramp-test-temporary-file-directory)
+ (file-truename ert-remote-temporary-file-directory)
(funcall (ert-test-body ert-test)))))))
-(tramp--test--deftest-direct-async-process tramp-test29-start-file-process
- "Check direct async `start-file-process'.")
+(tramp--test-deftest-direct-async-process tramp-test29-start-file-process)
(ert-deftest tramp-test30-make-process ()
"Check `make-process'."
@@ -4773,21 +4980,23 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(skip-unless (tramp--test-emacs27-p))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
- (let ((default-directory tramp-test-temporary-file-directory)
+ (let ((default-directory ert-remote-temporary-file-directory)
(tmp-name (tramp--test-make-temp-name nil quoted))
- kill-buffer-query-functions proc)
+ kill-buffer-query-functions command proc)
(with-no-warnings (should-not (make-process)))
;; Simple process.
(unwind-protect
(with-temp-buffer
- (setq proc
+ (setq command '("cat")
+ proc
(with-no-warnings
(make-process
- :name "test1" :buffer (current-buffer) :command '("cat")
+ :name "test1" :buffer (current-buffer) :command command
:file-handler t)))
(should (processp proc))
(should (equal (process-status proc) 'run))
+ (should (equal (process-get proc 'remote-command) command))
(process-send-string proc "foo\n")
(process-send-eof proc)
;; Read output.
@@ -4804,13 +5013,14 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(with-temp-buffer
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
- (setq proc
+ (setq command `("cat" ,(file-name-nondirectory tmp-name))
+ proc
(with-no-warnings
(make-process
- :name "test2" :buffer (current-buffer)
- :command `("cat" ,(file-name-nondirectory tmp-name))
+ :name "test2" :buffer (current-buffer) :command command
:file-handler t)))
(should (processp proc))
+ (should (equal (process-get proc 'remote-command) command))
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
@@ -4825,16 +5035,18 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
;; Process filter.
(unwind-protect
(with-temp-buffer
- (setq proc
+ (setq command '("cat")
+ proc
(with-no-warnings
(make-process
- :name "test3" :buffer (current-buffer) :command '("cat")
+ :name "test3" :buffer (current-buffer) :command command
:filter
(lambda (p s)
(with-current-buffer (process-buffer p) (insert s)))
:file-handler t)))
(should (processp proc))
(should (equal (process-status proc) 'run))
+ (should (equal (process-get proc 'remote-command) command))
(process-send-string proc "foo\n")
(process-send-eof proc)
;; Read output.
@@ -4850,14 +5062,16 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(unless (tramp--test-sshfs-p)
(unwind-protect
(with-temp-buffer
- (setq proc
+ (setq command '("cat")
+ proc
(with-no-warnings
(make-process
- :name "test3" :buffer (current-buffer) :command '("cat")
+ :name "test4" :buffer (current-buffer) :command command
:filter t
:file-handler t)))
(should (processp proc))
(should (equal (process-status proc) 'run))
+ (should (equal (process-get proc 'remote-command) command))
(process-send-string proc "foo\n")
(process-send-eof proc)
;; Read output. There shouldn't be any.
@@ -4873,16 +5087,18 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
;; Process sentinel.
(unwind-protect
(with-temp-buffer
- (setq proc
+ (setq command '("cat")
+ proc
(with-no-warnings
(make-process
- :name "test4" :buffer (current-buffer) :command '("cat")
+ :name "test5" :buffer (current-buffer) :command command
:sentinel
(lambda (p s)
(with-current-buffer (process-buffer p) (insert s)))
:file-handler t)))
(should (processp proc))
(should (equal (process-status proc) 'run))
+ (should (equal (process-get proc 'remote-command) command))
(process-send-string proc "foo\n")
(process-send-eof proc)
(delete-process proc)
@@ -4890,7 +5106,9 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output proc 0 nil t)))
;; On some MS Windows systems, it returns "unknown signal".
- (should (string-match-p "unknown signal\\|killed" (buffer-string))))
+ (should
+ (string-match-p
+ (rx (| "unknown signal" "killed")) (buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
@@ -4901,14 +5119,15 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(let ((stderr (generate-new-buffer "*stderr*")))
(unwind-protect
(with-temp-buffer
- (setq proc
+ (setq command '("cat" "/does-not-exist")
+ proc
(with-no-warnings
(make-process
- :name "test5" :buffer (current-buffer)
- :command '("cat" "/does-not-exist")
+ :name "test6" :buffer (current-buffer) :command
command
:stderr stderr
:file-handler t)))
(should (processp proc))
+ (should (equal (process-get proc 'remote-command) command))
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output proc 0 nil t)))
@@ -4922,7 +5141,8 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(delete-process proc)
(should
(string-match-p
- "cat:.* No such file or directory" (buffer-string)))))
+ (rx "cat:" (* nonl) " No such file or directory")
+ (buffer-string)))))
;; Cleanup.
(ignore-errors (delete-process proc))
@@ -4932,14 +5152,15 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(unless (tramp-direct-async-process-p)
(unwind-protect
(with-temp-buffer
- (setq proc
+ (setq command '("cat" "/does-not-exist")
+ proc
(with-no-warnings
(make-process
- :name "test6" :buffer (current-buffer)
- :command '("cat" "/does-not-exist")
+ :name "test7" :buffer (current-buffer) :command command
:stderr tmp-name
:file-handler t)))
(should (processp proc))
+ (should (equal (process-get proc 'remote-command) command))
;; Read stderr.
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output proc nil nil t)))
@@ -4948,7 +5169,8 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(insert-file-contents tmp-name)
(should
(string-match-p
- "cat:.* No such file or directory" (buffer-string)))))
+ (rx "cat:" (* nonl) " No such file or directory")
+ (buffer-string)))))
;; Cleanup.
(ignore-errors (delete-process proc))
@@ -4970,18 +5192,20 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(unless connection-type '(nil pipe t pty)))
(unwind-protect
(with-temp-buffer
- (setq proc
+ (setq command '("hexdump" "-v" "-e" "/1 \"%02X\n\"")
+ proc
(with-no-warnings
(make-process
:name
- (format "test7-%s-%s"
+ (format "test8-%s-%s"
connection-type process-connection-type)
:buffer (current-buffer)
:connection-type connection-type
- :command '("hexdump" "-v" "-e" "/1 \"%02X\n\"")
+ :command command
:file-handler t)))
(should (processp proc))
(should (equal (process-status proc) 'run))
+ (should (equal (process-get proc 'remote-command) command))
(process-send-string proc "foo\r\n")
(process-send-eof proc)
;; Read output.
@@ -4997,43 +5221,44 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
;; On macOS, there is always newline conversion.
;; "telnet" converts \r to <CR><NUL> if `crlf'
;; flag is FALSE. See telnet(1) man page.
- "66\n6F\n6F\n0D\\(\n00\\)?\n0A\n"
- "66\n6F\n6F\n0A\\(\n00\\)?\n0A\n")
+ (rx "66\n6F\n6F\n0D" (? "\n00") "\n0A\n")
+ (rx "66\n6F\n6F\n0A" (? "\n00") "\n0A\n"))
(buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))))))))
-(tramp--test--deftest-direct-async-process tramp-test30-make-process
- "Check direct async `make-process'.")
+(tramp--test-deftest-direct-async-process tramp-test30-make-process)
(ert-deftest tramp-test31-interrupt-process ()
"Check `interrupt-process'."
- :tags (append '(:expensive-test :tramp-asynchronous-processes)
- (and (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI"))
- '(:unstable)))
+ ;; The final `process-live-p' check does not run sufficiently.
+ :tags '(:expensive-test :tramp-asynchronous-processes :unstable)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-windows-nt-p)))
(skip-unless (not (tramp--test-crypt-p)))
- ;; Since Emacs 26.1.
- (skip-unless (boundp 'interrupt-process-functions))
+ ;; Since Emacs 27.1.
+ (skip-unless (macrop 'with-connection-local-variables))
;; We must use `file-truename' for the temporary directory, in
;; order to establish the connection prior running an asynchronous
;; process.
- (let ((default-directory (file-truename tramp-test-temporary-file-directory))
+ (let ((default-directory (file-truename ert-remote-temporary-file-directory))
(delete-exited-processes t)
- kill-buffer-query-functions proc)
+ kill-buffer-query-functions command proc)
(unwind-protect
(with-temp-buffer
- (setq proc (start-file-process-shell-command
- "test" (current-buffer)
- "trap 'echo boom; exit 1' 2; sleep 100"))
+ (setq command "trap 'echo boom; exit 1' 2; sleep 100"
+ proc (start-file-process-shell-command
+ "test" (current-buffer) command))
(should (processp proc))
(should (process-live-p proc))
(should (equal (process-status proc) 'run))
(should (numberp (process-get proc 'remote-pid)))
+ (should (equal (process-get proc 'remote-command)
+ (with-connection-local-variables
+ `(,shell-file-name ,shell-command-switch ,command))))
(should (interrupt-process proc))
;; Let the process accept the interrupt.
(with-timeout (10 (tramp--test-timeout-handler))
@@ -5048,12 +5273,147 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
;; Cleanup.
(ignore-errors (delete-process proc)))))
+(ert-deftest tramp-test31-signal-process ()
+ "Check `signal-process'."
+ ;; The final `process-live-p' check does not run sufficiently.
+ :tags '(:expensive-test :tramp-asynchronous-processes :unstable)
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (tramp--test-sh-p))
+ (skip-unless (not (tramp--test-windows-nt-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
+ ;; Since Emacs 27.1.
+ (skip-unless (macrop 'with-connection-local-variables))
+ ;; Since Emacs 29.1.
+ (skip-unless (boundp 'signal-process-functions))
+
+ ;; We must use `file-truename' for the temporary directory, in
+ ;; order to establish the connection prior running an asynchronous
+ ;; process.
+ (let ((default-directory (file-truename ert-remote-temporary-file-directory))
+ (delete-exited-processes t)
+ kill-buffer-query-functions command proc)
+
+ (dolist (sigcode '(2 INT))
+ (unwind-protect
+ (with-temp-buffer
+ (setq command "trap 'echo boom; exit 1' 2; sleep 100"
+ proc (start-file-process-shell-command
+ (format "test1%s" sigcode) (current-buffer) command))
+ (should (processp proc))
+ (should (process-live-p proc))
+ (should (equal (process-status proc) 'run))
+ (should (numberp (process-get proc 'remote-pid)))
+ (should (equal (process-get proc 'remote-command)
+ (with-connection-local-variables
+ `(,shell-file-name ,shell-command-switch
,command))))
+ (should (zerop (signal-process proc sigcode)))
+ ;; Let the process accept the signal.
+ (with-timeout (10 (tramp--test-timeout-handler))
+ (while (accept-process-output proc 0 nil t)))
+ (should-not (process-live-p proc)))
+
+ ;; Cleanup.
+ (ignore-errors (kill-process proc))
+ (ignore-errors (delete-process proc)))
+
+ (unwind-protect
+ (with-temp-buffer
+ (setq command "trap 'echo boom; exit 1' 2; sleep 100"
+ proc (start-file-process-shell-command
+ (format "test2%s" sigcode) (current-buffer) command))
+ (should (processp proc))
+ (should (process-live-p proc))
+ (should (equal (process-status proc) 'run))
+ (should (numberp (process-get proc 'remote-pid)))
+ (should (equal (process-get proc 'remote-command)
+ (with-connection-local-variables
+ `(,shell-file-name ,shell-command-switch
,command))))
+ ;; `signal-process' has argument REMOTE since Emacs 29.
+ (with-no-warnings
+ (should
+ (zerop
+ (signal-process
+ (process-get proc 'remote-pid) sigcode default-directory))))
+ ;; Let the process accept the signal.
+ (with-timeout (10 (tramp--test-timeout-handler))
+ (while (accept-process-output proc 0 nil t)))
+ (should-not (process-live-p proc)))
+
+ ;; Cleanup.
+ (ignore-errors (kill-process proc))
+ (ignore-errors (delete-process proc))))))
+
+(ert-deftest tramp-test31-list-system-processes ()
+ "Check `list-system-processes'."
+ :tags '(:expensive-test)
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (tramp--test-supports-processes-p))
+ ;; `list-system-processes' is supported since Emacs 29.1.
+ (skip-unless (tramp--test-emacs29-p))
+
+ (let ((default-directory ert-remote-temporary-file-directory))
+ (skip-unless (consp (list-system-processes)))
+ (should (not (equal (list-system-processes)
+ (let ((default-directory temporary-file-directory))
+ (list-system-processes)))))))
+
+(ert-deftest tramp-test31-process-attributes ()
+ "Check `process-attributes'."
+ :tags '(:expensive-test :tramp-asynchronous-processes)
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (tramp--test-supports-processes-p))
+ ;; `process-attributes' is supported since Emacs 29.1.
+ (skip-unless (tramp--test-emacs29-p))
+
+ ;; We must use `file-truename' for the temporary directory, in
+ ;; order to establish the connection prior running an asynchronous
+ ;; process.
+ (let ((default-directory (file-truename ert-remote-temporary-file-directory))
+ (delete-exited-processes t)
+ kill-buffer-query-functions command proc)
+ (skip-unless (consp (list-system-processes)))
+
+ (unwind-protect
+ (progn
+ (setq command '("sleep" "100")
+ proc (apply #'start-file-process "test" nil command))
+ (while (accept-process-output proc 0))
+ (when-let ((pid (process-get proc 'remote-pid))
+ (attributes (process-attributes pid)))
+ ;; (tramp--test-message "%s" attributes)
+ (should (equal (cdr (assq 'comm attributes)) (car command)))
+ (should (equal (cdr (assq 'args attributes))
+ (mapconcat #'identity command " ")))))
+
+ ;; Cleanup.
+ (ignore-errors (delete-process proc)))))
+
+(ert-deftest tramp-test31-memory-info ()
+ "Check `memory-info'."
+ :tags '(:expensive-test)
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (tramp--test-supports-processes-p))
+ ;; `memory-info' is supported since Emacs 29.1.
+ (skip-unless (tramp--test-emacs29-p))
+
+ (when-let ((default-directory ert-remote-temporary-file-directory)
+ (mi (memory-info)))
+ (should (consp mi))
+ (should (= (length mi) 4))
+ (dotimes (i (length mi))
+ (should (natnump (nth i mi))))))
+
(defun tramp--test-async-shell-command
(command output-buffer &optional error-buffer input)
"Like `async-shell-command', reading the output.
INPUT, if non-nil, is a string sent to the process."
(let ((proc (async-shell-command command output-buffer error-buffer))
(delete-exited-processes t))
+ ;; Since Emacs 27.1.
+ (when (macrop 'with-connection-local-variables)
+ (should (equal (process-get proc 'remote-command)
+ (with-connection-local-variables
+ `(,shell-file-name ,shell-command-switch ,command)))))
(cl-letf (((symbol-function #'shell-command-sentinel) #'ignore))
(when (stringp input)
(process-send-string proc input))
@@ -5081,7 +5441,7 @@ INPUT, if non-nil, is a string sent to the process."
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted))
- (default-directory tramp-test-temporary-file-directory)
+ (default-directory ert-remote-temporary-file-directory)
;; Suppress nasty messages.
(inhibit-message t)
kill-buffer-query-functions)
@@ -5126,8 +5486,8 @@ INPUT, if non-nil, is a string sent to the process."
"echo foo >&2; echo bar" (current-buffer) stderr)
(should (string-equal "bar\n" (buffer-string)))
;; Check stderr.
- (with-current-buffer stderr
- (should (string-equal "foo\n" (buffer-string)))))
+ (should
+ (string-equal "foo\n" (tramp-get-buffer-string stderr))))
;; Cleanup.
(ignore-errors (kill-buffer stderr))))))
@@ -5143,15 +5503,11 @@ INPUT, if non-nil, is a string sent to the process."
;; String to be sent.
(format "%s\n" (file-name-nondirectory tmp-name)))
(should
- (string-equal
- ;; tramp-adb.el echoes, so we must add the string.
- (if (and (tramp--test-adb-p)
- (not (tramp-direct-async-process-p)))
- (format
- "%s\n%s\n"
- (file-name-nondirectory tmp-name)
- (file-name-nondirectory tmp-name))
- (format "%s\n" (file-name-nondirectory tmp-name)))
+ (string-match-p
+ ;; Some shells echo, for example the "adb" or "docker" methods.
+ (tramp-compat-rx
+ bos (** 1 2 (literal (file-name-nondirectory tmp-name)) "\n")
+ eos)
(buffer-string))))
;; Cleanup.
@@ -5162,15 +5518,14 @@ INPUT, if non-nil, is a string sent to the process."
(when (and (tramp--test-asynchronous-processes-p)
(tramp--test-sh-p) (tramp--test-emacs27-p))
(let* ((async-shell-command-width 1024)
- (default-directory tramp-test-temporary-file-directory)
+ (default-directory ert-remote-temporary-file-directory)
(cols (ignore-errors
(read (tramp--test-shell-command-to-string-asynchronously
"tput cols")))))
(when (natnump cols)
(should (= cols async-shell-command-width))))))
-(tramp--test--deftest-direct-async-process tramp-test32-shell-command
- "Check direct async `shell-command'." 'unstable)
+(tramp--test-deftest-direct-async-process tramp-test32-shell-command 'unstable)
;; This test is inspired by Bug#39067.
(ert-deftest tramp-test32-shell-command-dont-erase-buffer ()
@@ -5214,7 +5569,7 @@ INPUT, if non-nil, is a string sent to the process."
;; We check both the local and remote case, in order to guarantee
;; that they behave similar.
(dolist (default-directory
- `(,temporary-file-directory ,tramp-test-temporary-file-directory))
+ `(,temporary-file-directory ,ert-remote-temporary-file-directory))
;; These are the possible values of `shell-command-dont-erase-buffer'.
;; `random' is taken as non-nil value without special meaning.
(dolist (shell-command-dont-erase-buffer
@@ -5314,7 +5669,7 @@ INPUT, if non-nil, is a string sent to the process."
(and (tramp--test-asynchronous-processes-p)
'(tramp--test-shell-command-to-string-asynchronously))))
- (let ((default-directory tramp-test-temporary-file-directory)
+ (let ((default-directory ert-remote-temporary-file-directory)
(shell-file-name "/bin/sh")
(envvar (concat "VAR_" (upcase (md5 (current-time-string)))))
kill-buffer-query-functions)
@@ -5357,7 +5712,7 @@ INPUT, if non-nil, is a string sent to the process."
;; Variable is set.
(should
(string-match-p
- (regexp-quote envvar)
+ (tramp-compat-rx (literal envvar))
(funcall this-shell-command-to-string "set"))))
(unless (tramp-direct-async-process-p)
@@ -5384,16 +5739,14 @@ INPUT, if non-nil, is a string sent to the process."
;; Variable is unset.
(should-not
(string-match-p
- (regexp-quote envvar)
+ (tramp-compat-rx (literal envvar))
;; We must remove PS1, the output is truncated otherwise.
;; We must suppress "_=VAR...".
(funcall
this-shell-command-to-string
"printenv | grep -v PS1 | grep -v _=")))))))))
-(tramp--test--deftest-direct-async-process tramp-test33-environment-variables
- "Check that remote processes set / unset environment variables properly.
-Use direct async.")
+(tramp--test-deftest-direct-async-process tramp-test33-environment-variables)
;; This test is inspired by Bug#27009.
(ert-deftest tramp-test33-environment-variables-and-port-numbers ()
@@ -5405,7 +5758,7 @@ Use direct async.")
(skip-unless (not (tramp--test-crypt-p)))
;; We force a reconnect, in order to have a clean environment.
- (dolist (dir `(,tramp-test-temporary-file-directory
+ (dolist (dir `(,ert-remote-temporary-file-directory
"/mock:localhost#11111:" "/mock:localhost#22222:"))
(tramp-cleanup-connection
(tramp-dissect-file-name dir) 'keep-debug 'keep-password))
@@ -5437,12 +5790,9 @@ Use direct async.")
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
;; Since Emacs 27.1.
- (skip-unless (fboundp 'with-connection-local-variables))
+ (skip-unless (macrop 'with-connection-local-variables))
- ;; `connection-local-set-profile-variables' and
- ;; `connection-local-set-profiles' exist since Emacs 26.1. We don't
- ;; want to see compiler warnings for older Emacsen.
- (let* ((default-directory tramp-test-temporary-file-directory)
+ (let* ((default-directory ert-remote-temporary-file-directory)
(tmp-name1 (tramp--test-make-temp-name))
(tmp-name2 (expand-file-name "foo" tmp-name1))
(enable-local-variables :all)
@@ -5456,24 +5806,25 @@ Use direct async.")
(should (file-directory-p tmp-name1))
;; `local-variable' is buffer-local due to explicit setting.
+ ;; We need `with-no-warnings', because `defvar-local' is not
+ ;; called at toplevel.
(with-no-warnings
- (defvar-local local-variable 'buffer))
+ (defvar-local local-variable 'buffer))
(with-temp-buffer
(should (eq local-variable 'buffer)))
;; `local-variable' is connection-local due to Tramp.
(write-region "foo" nil tmp-name2)
(should (file-exists-p tmp-name2))
- (with-no-warnings
- (connection-local-set-profile-variables
- 'local-variable-profile
- '((local-variable . connect)))
- (connection-local-set-profiles
- `(:application tramp
- :protocol ,(file-remote-p default-directory 'method)
- :user ,(file-remote-p default-directory 'user)
- :machine ,(file-remote-p default-directory 'host))
- 'local-variable-profile))
+ (connection-local-set-profile-variables
+ 'local-variable-profile
+ '((local-variable . connect)))
+ (connection-local-set-profiles
+ `(:application tramp
+ :protocol ,(file-remote-p default-directory 'method)
+ :user ,(file-remote-p default-directory 'user)
+ :machine ,(file-remote-p default-directory 'host))
+ 'local-variable-profile)
(with-current-buffer (find-file-noselect tmp-name2)
(should (eq local-variable 'connect))
(kill-buffer (current-buffer)))
@@ -5498,7 +5849,6 @@ Use direct async.")
;; Cleanup.
(ignore-errors (delete-directory tmp-name1 'recursive)))))
-;; The functions were introduced in Emacs 26.1.
(ert-deftest tramp-test34-explicit-shell-file-name ()
"Check that connection-local `explicit-shell-file-name' is set."
:tags '(:expensive-test :tramp-asynchronous-processes)
@@ -5508,14 +5858,8 @@ Use direct async.")
;; remote processes in Emacs. That doesn't work for tramp-adb.el.
(when (tramp--test-adb-p)
(skip-unless (tramp--test-emacs27-p)))
- ;; Since Emacs 26.1.
- (skip-unless (and (fboundp 'connection-local-set-profile-variables)
- (fboundp 'connection-local-set-profiles)))
-
- ;; `connection-local-set-profile-variables' and
- ;; `connection-local-set-profiles' exist since Emacs 26.1. We don't
- ;; want to see compiler warnings for older Emacsen.
- (let ((default-directory tramp-test-temporary-file-directory)
+
+ (let ((default-directory ert-remote-temporary-file-directory)
explicit-shell-file-name kill-buffer-query-functions
connection-local-profile-alist connection-local-criteria-alist)
(unwind-protect
@@ -5523,19 +5867,16 @@ Use direct async.")
;; `shell-mode' would ruin our test, because it deletes all
;; buffer local variables. Not needed in Emacs 27.1.
(put 'explicit-shell-file-name 'permanent-local t)
- ;; Declare connection-local variables `explicit-shell-file-name'
- ;; and `explicit-sh-args'.
- (with-no-warnings
- (connection-local-set-profile-variables
- 'remote-sh
- `((explicit-shell-file-name . ,(tramp--test-shell-file-name))
- (explicit-sh-args . ("-c" "echo foo"))))
- (connection-local-set-profiles
- `(:application tramp
- :protocol ,(file-remote-p default-directory 'method)
- :user ,(file-remote-p default-directory 'user)
- :machine ,(file-remote-p default-directory 'host))
- 'remote-sh))
+ (connection-local-set-profile-variables
+ 'remote-sh
+ `((explicit-shell-file-name . ,(tramp--test-shell-file-name))
+ (explicit-sh-args . ("-c" "echo foo"))))
+ (connection-local-set-profiles
+ `(:application tramp
+ :protocol ,(file-remote-p default-directory 'method)
+ :user ,(file-remote-p default-directory 'user)
+ :machine ,(file-remote-p default-directory 'host))
+ 'remote-sh)
(put 'explicit-shell-file-name 'safe-local-variable #'identity)
(put 'explicit-sh-args 'safe-local-variable #'identity)
@@ -5550,7 +5891,7 @@ Use direct async.")
(with-timeout (10)
(while (accept-process-output
(get-buffer-process (current-buffer)) nil nil t)))
- (should (string-match-p "^foo$" (buffer-string)))))
+ (should (string-match-p (rx bol "foo" eol) (buffer-string)))))
;; Cleanup.
(put 'explicit-shell-file-name 'permanent-local nil)
@@ -5568,7 +5909,7 @@ Use direct async.")
(skip-unless (fboundp 'exec-path))
(let ((tmp-name (tramp--test-make-temp-name))
- (default-directory tramp-test-temporary-file-directory))
+ (default-directory ert-remote-temporary-file-directory))
(unwind-protect
(progn
(should (consp (with-no-warnings (exec-path))))
@@ -5613,7 +5954,7 @@ Use direct async.")
(skip-unless (fboundp 'exec-path))
(let* ((tmp-name (tramp--test-make-temp-name))
- (default-directory tramp-test-temporary-file-directory)
+ (default-directory ert-remote-temporary-file-directory)
(orig-exec-path (with-no-warnings (exec-path)))
(tramp-remote-path tramp-remote-path)
(orig-tramp-remote-path tramp-remote-path)
@@ -5680,7 +6021,7 @@ Use direct async.")
;; order to establish the connection prior running an asynchronous
;; process.
(let* ((default-directory
- (file-truename tramp-test-temporary-file-directory))
+ (file-truename ert-remote-temporary-file-directory))
(tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (expand-file-name "foo" tmp-name1))
(tramp-remote-process-environment tramp-remote-process-environment)
@@ -5784,7 +6125,7 @@ Use direct async.")
(if quoted #'tramp-compat-file-name-quote #'identity)
(expand-file-name
(format "#%s#" (file-name-nondirectory tmp-name1))
- tramp-test-temporary-file-directory))))))
+ ert-remote-temporary-file-directory))))))
;; Use default `tramp-auto-save-directory' mechanism.
;; Ange-FTP doesn't care.
@@ -5838,7 +6179,7 @@ Use direct async.")
;; files, owned by root.
(let ((tramp-auto-save-directory temporary-file-directory))
(write-region "foo" nil tmp-name1)
- (when (zerop (or (tramp-compat-file-attribute-user-id
+ (when (zerop (or (file-attribute-user-id
(file-attributes tmp-name1))
tramp-unknown-id-integer))
(with-temp-buffer
@@ -5889,7 +6230,7 @@ Use direct async.")
(if quoted #'tramp-compat-file-name-quote #'identity)
(expand-file-name
(format "%s~" (file-name-nondirectory tmp-name1))
- tramp-test-temporary-file-directory)))))))
+ ert-remote-temporary-file-directory)))))))
(unwind-protect
;; Map `backup-directory-alist'.
@@ -5985,8 +6326,7 @@ Use direct async.")
(let ((backup-directory-alist `(("." . ,temporary-file-directory)))
tramp-backup-directory-alist)
(write-region "foo" nil tmp-name1)
- (when (zerop (or (tramp-compat-file-attribute-user-id
- (file-attributes tmp-name1))
+ (when (zerop (or (file-attribute-user-id (file-attributes
tmp-name1))
tramp-unknown-id-integer))
(tramp-cleanup-connection
tramp-test-vec 'keep-debug 'keep-password)
@@ -6048,7 +6388,9 @@ Use direct async.")
(with-temp-buffer
(set-visited-file-name tmp-name1)
(insert "foo")
- (save-buffer))
+ (should (buffer-modified-p))
+ (save-buffer)
+ (should-not (buffer-modified-p)))
(should-not (with-no-warnings (file-locked-p tmp-name1)))
(with-no-warnings (lock-file tmp-name1))
(should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
@@ -6067,7 +6409,7 @@ Use direct async.")
;; When `lock-file-name-transforms' is set, another lock
;; file is used.
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
- (let ((lock-file-name-transforms `((".*" ,tmp-name2))))
+ (let ((lock-file-name-transforms `((,(rx (* nonl)) ,tmp-name2))))
(should
(string-equal
(with-no-warnings (make-lock-file-name tmp-name1))
@@ -6122,8 +6464,7 @@ Use direct async.")
;; files, owned by root.
(let ((lock-file-name-transforms auto-save-file-name-transforms))
(write-region "foo" nil tmp-name1)
- (when (zerop (or (tramp-compat-file-attribute-user-id
- (file-attributes tmp-name1))
+ (when (zerop (or (file-attribute-user-id (file-attributes
tmp-name1))
tramp-unknown-id-integer))
(tramp-cleanup-connection
tramp-test-vec 'keep-debug 'keep-password)
@@ -6171,42 +6512,46 @@ Use direct async.")
;; buffer results in a prompt.
(cl-letf (((symbol-function 'yes-or-no-p)
(lambda (_) (ert-fail "Test failed unexpectedly"))))
- (save-buffer))
+ (should (buffer-modified-p))
+ (save-buffer)
+ (should-not (buffer-modified-p)))
(should-not (file-locked-p tmp-name))
- ;; Macro `ert-with-message-capture' was introduced in Emacs
26.1.
- (with-no-warnings (when (symbol-plist 'ert-with-message-capture)
- ;; For local files, just changing the file
- ;; modification on disk doesn't hurt, because file
- ;; contents in buffer and on disk are equal. For
- ;; remote files, file contents is not compared. We
- ;; mock an older modification time in buffer,
- ;; because Tramp regards modification times equal if
- ;; they differ for less than 2 seconds.
- (set-visited-file-modtime (time-add (current-time) -60))
- ;; Some Tramp methods cannot check the file
- ;; modification time properly, for them it doesn't
- ;; make sense to test.
- (when (not (verify-visited-file-modtime))
- (cl-letf (((symbol-function 'read-char-choice)
- (lambda (prompt &rest _) (message "%s" prompt)
?y)))
- (ert-with-message-capture captured-messages
- (insert "bar")
- (when create-lockfiles
- (should (string-match-p
- (format
- "^%s changed on disk; really edit the
buffer\\?"
- (if (tramp--test-crypt-p)
- ".+" (file-name-nondirectory tmp-name)))
- captured-messages))
- (should (file-locked-p tmp-name)))))
-
- ;; `save-buffer' removes the file lock.
- (cl-letf (((symbol-function 'yes-or-no-p)
#'tramp--test-always)
- ((symbol-function 'read-char-choice)
- (lambda (&rest _) ?y)))
- (save-buffer))
- (should-not (file-locked-p tmp-name))))))
+ ;; For local files, just changing the file
+ ;; modification on disk doesn't hurt, because file
+ ;; contents in buffer and on disk are equal. For
+ ;; remote files, file contents is not compared. We
+ ;; mock an older modification time in buffer, because
+ ;; Tramp regards modification times equal if they
+ ;; differ for less than 2 seconds.
+ (set-visited-file-modtime (time-add (current-time) -60))
+ ;; Some Tramp methods cannot check the file
+ ;; modification time properly, for them it doesn't
+ ;; make sense to test.
+ (when (not (verify-visited-file-modtime))
+ (cl-letf (((symbol-function 'read-char-choice)
+ (lambda (prompt &rest _) (message "%s" prompt)
?y)))
+ (ert-with-message-capture captured-messages
+ (insert "bar")
+ (when create-lockfiles
+ (should (string-match-p
+ (rx-to-string
+ `(: bol
+ ,(if (tramp--test-crypt-p)
+ '(+ nonl)
+ (file-name-nondirectory tmp-name))
+ " changed on disk; really edit the
buffer?"))
+ captured-messages))
+ (should (file-locked-p tmp-name)))))
+
+ ;; `save-buffer' removes the file lock.
+ (cl-letf (((symbol-function 'yes-or-no-p)
#'tramp--test-always)
+ ((symbol-function 'read-char-choice)
+ (lambda (&rest _) ?y)))
+ (should (buffer-modified-p))
+ (save-buffer)
+ (should-not (buffer-modified-p)))
+ (should-not (file-locked-p tmp-name))))
;; Cleanup.
(set-buffer-modified-p nil)
@@ -6219,24 +6564,18 @@ Use direct async.")
"Check `make-nearby-temp-file' and `temporary-file-directory'."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-ange-ftp-p)))
- ;; Since Emacs 26.1.
- (skip-unless
- (and (fboundp 'make-nearby-temp-file) (fboundp 'temporary-file-directory)))
- ;; `make-nearby-temp-file' and `temporary-file-directory' exists
- ;; since Emacs 26.1. We don't want to see compiler warnings for
- ;; older Emacsen.
- (let ((default-directory tramp-test-temporary-file-directory)
+ (let ((default-directory ert-remote-temporary-file-directory)
tmp-file)
;; The remote host shall know a temporary file directory.
- (should (stringp (with-no-warnings (temporary-file-directory))))
+ (should (stringp (temporary-file-directory)))
(should
(string-equal
(file-remote-p default-directory)
- (file-remote-p (with-no-warnings (temporary-file-directory)))))
+ (file-remote-p (temporary-file-directory))))
;; The temporary file shall be located on the remote host.
- (setq tmp-file (with-no-warnings (make-nearby-temp-file "tramp-test")))
+ (setq tmp-file (make-nearby-temp-file "tramp-test"))
(should (file-exists-p tmp-file))
(should (file-regular-p tmp-file))
(should
@@ -6246,44 +6585,44 @@ Use direct async.")
(delete-file tmp-file)
(should-not (file-exists-p tmp-file))
- (setq tmp-file (with-no-warnings (make-nearby-temp-file "tramp-test"
'dir)))
+ (setq tmp-file (make-nearby-temp-file "tramp-test" 'dir))
(should (file-exists-p tmp-file))
(should (file-directory-p tmp-file))
(delete-directory tmp-file)
(should-not (file-exists-p tmp-file))))
-(defun tramp--test-emacs26-p ()
- "Check for Emacs version >= 26.1.
-Some semantics has been changed for there, w/o new functions or
-variables, so we check the Emacs version directly."
- (>= emacs-major-version 26))
-
(defun tramp--test-emacs27-p ()
"Check for Emacs version >= 27.1.
-Some semantics has been changed for there, w/o new functions or
-variables, so we check the Emacs version directly."
+Some semantics has been changed for there, without new functions
+or variables, so we check the Emacs version directly."
(>= emacs-major-version 27))
(defun tramp--test-emacs28-p ()
"Check for Emacs version >= 28.1.
-Some semantics has been changed for there, w/o new functions or
-variables, so we check the Emacs version directly."
+Some semantics has been changed for there, without new functions
+or variables, so we check the Emacs version directly."
(>= emacs-major-version 28))
+(defun tramp--test-emacs29-p ()
+ "Check for Emacs version >= 29.1.
+Some semantics has been changed for there, without new functions
+or variables, so we check the Emacs version directly."
+ (>= emacs-major-version 29))
+
(defun tramp--test-adb-p ()
"Check, whether the remote host runs Android.
This requires restrictions of file name syntax."
- (tramp-adb-file-name-p tramp-test-temporary-file-directory))
+ (tramp-adb-file-name-p ert-remote-temporary-file-directory))
(defun tramp--test-ange-ftp-p ()
"Check, whether Ange-FTP is used."
(eq
- (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
+ (tramp-find-foreign-file-name-handler tramp-test-vec)
'tramp-ftp-file-name-handler))
(defun tramp--test-asynchronous-processes-p ()
"Whether asynchronous processes tests are run.
-This is used in tests which we dont't want to tag
+This is used in tests which we don't want to tag
`:tramp-asynchronous-processes' completely."
(and
(ert-select-tests
@@ -6292,21 +6631,21 @@ This is used in tests which we dont't want to tag
:body nil :tags '(:tramp-asynchronous-processes))))
;; tramp-adb.el cannot apply multi-byte commands.
(not (and (tramp--test-adb-p)
- (string-match-p "[[:multibyte:]]" default-directory)))))
+ (string-match-p (tramp-compat-rx multibyte) default-directory)))))
(defun tramp--test-crypt-p ()
"Check, whether the remote directory is encrypted."
- (tramp-crypt-file-name-p tramp-test-temporary-file-directory))
+ (tramp-crypt-file-name-p ert-remote-temporary-file-directory))
(defun tramp--test-docker-p ()
"Check, whether the docker method is used.
This does not support some special file names."
(string-equal
- "docker" (file-remote-p tramp-test-temporary-file-directory 'method)))
+ "docker" (file-remote-p ert-remote-temporary-file-directory 'method)))
(defun tramp--test-expensive-test-p ()
"Whether expensive tests are run.
-This is used in tests which we dont't want to tag `:expensive'
+This is used in tests which we don't want to tag `:expensive'
completely."
(ert-select-tests
(ert--stats-selector ert--current-run-stats)
@@ -6317,8 +6656,8 @@ completely."
"Check, whether an FTP-like method is used.
This does not support globbing characters in file names (yet)."
;; Globbing characters are ??, ?* and ?\[.
- (string-match-p
- "ftp$" (file-remote-p tramp-test-temporary-file-directory 'method)))
+ (string-suffix-p
+ "ftp" (file-remote-p ert-remote-temporary-file-directory 'method)))
(defun tramp--test-fuse-p ()
"Check, whether an FUSE file system isused."
@@ -6327,42 +6666,43 @@ This does not support globbing characters in file names
(yet)."
(defun tramp--test-gdrive-p ()
"Check, whether the gdrive method is used."
(string-equal
- "gdrive" (file-remote-p tramp-test-temporary-file-directory 'method)))
+ "gdrive" (file-remote-p ert-remote-temporary-file-directory 'method)))
(defun tramp--test-gvfs-p (&optional method)
"Check, whether the remote host runs a GVFS based method.
This requires restrictions of file name syntax.
If optional METHOD is given, it is checked first."
(or (member method tramp-gvfs-methods)
- (tramp-gvfs-file-name-p tramp-test-temporary-file-directory)))
+ (tramp-gvfs-file-name-p ert-remote-temporary-file-directory)))
(defun tramp--test-hpux-p ()
"Check, whether the remote host runs HP-UX.
Several special characters do not work properly there."
;; We must refill the cache. `file-truename' does it.
- (file-truename tramp-test-temporary-file-directory)
- (ignore-errors (tramp-check-remote-uname tramp-test-vec "^HP-UX")))
+ (file-truename ert-remote-temporary-file-directory)
+ (ignore-errors (tramp-check-remote-uname tramp-test-vec (rx bol "HP-UX"))))
(defun tramp--test-ksh-p ()
"Check, whether the remote shell is ksh.
ksh93 makes some strange conversions of non-latin characters into
a $'' syntax."
;; We must refill the cache. `file-truename' does it.
- (file-truename tramp-test-temporary-file-directory)
- (string-match-p
- "ksh$" (tramp-get-connection-property tramp-test-vec "remote-shell" "")))
+ (file-truename ert-remote-temporary-file-directory)
+ (string-suffix-p
+ "ksh"
+ (tramp-get-connection-property tramp-test-vec "remote-shell" "")))
(defun tramp--test-macos-p ()
"Check, whether the remote host runs macOS."
;; We must refill the cache. `file-truename' does it.
- (file-truename tramp-test-temporary-file-directory)
+ (file-truename ert-remote-temporary-file-directory)
(ignore-errors (tramp-check-remote-uname tramp-test-vec "Darwin")))
(defun tramp--test-mock-p ()
"Check, whether the mock method is used.
This does not support external Emacs calls."
(string-equal
- "mock" (file-remote-p tramp-test-temporary-file-directory 'method)))
+ "mock" (file-remote-p ert-remote-temporary-file-directory 'method)))
(defun tramp--test-out-of-band-p ()
"Check, whether an out-of-band method is used."
@@ -6371,13 +6711,13 @@ This does not support external Emacs calls."
(defun tramp--test-rclone-p ()
"Check, whether the remote host is offered by rclone.
This requires restrictions of file name syntax."
- (tramp-rclone-file-name-p tramp-test-temporary-file-directory))
+ (tramp-rclone-file-name-p ert-remote-temporary-file-directory))
(defun tramp--test-rsync-p ()
"Check, whether the rsync method is used.
This does not support special file names."
(string-equal
- "rsync" (file-remote-p tramp-test-temporary-file-directory 'method)))
+ "rsync" (file-remote-p ert-remote-temporary-file-directory 'method)))
(defun tramp--test-sh-p ()
"Check, whether the remote host runs a based method from tramp-sh.el."
@@ -6391,30 +6731,30 @@ Additionally, ls does not support \"--dired\"."
;; We must refill the cache. `insert-directory' does it.
;; This fails for tramp-crypt.el, so we ignore that.
(ignore-errors
- (insert-directory tramp-test-temporary-file-directory "-al"))
- (not (tramp-get-connection-property tramp-test-vec "ls--dired" nil)))))
+ (insert-directory ert-remote-temporary-file-directory "-al"))
+ (not (tramp-get-connection-property tramp-test-vec "ls--dired")))))
(defun tramp--test-share-p ()
"Check, whether the method needs a share."
(and (tramp--test-gvfs-p)
(string-match-p
- "^\\(afp\\|davs?\\|smb\\)$"
- (file-remote-p tramp-test-temporary-file-directory 'method))))
+ (rx bol (| "afp" (: "dav" (? "s")) "smb") eol)
+ (file-remote-p ert-remote-temporary-file-directory 'method))))
(defun tramp--test-sshfs-p ()
"Check, whether the remote host is offered by sshfs.
This requires restrictions of file name syntax."
- (tramp-sshfs-file-name-p tramp-test-temporary-file-directory))
+ (tramp-sshfs-file-name-p ert-remote-temporary-file-directory))
(defun tramp--test-sudoedit-p ()
"Check, whether the sudoedit method is used."
- (tramp-sudoedit-file-name-p tramp-test-temporary-file-directory))
+ (tramp-sudoedit-file-name-p ert-remote-temporary-file-directory))
(defun tramp--test-telnet-p ()
"Check, whether the telnet method is used.
This does not support special file names."
(string-equal
- "telnet" (file-remote-p tramp-test-temporary-file-directory 'method)))
+ "telnet" (file-remote-p ert-remote-temporary-file-directory 'method)))
(defun tramp--test-windows-nt-p ()
"Check, whether the locale host runs MS Windows."
@@ -6435,7 +6775,7 @@ This requires restrictions of file name syntax."
(defun tramp--test-smb-p ()
"Check, whether the locale or remote host runs MS Windows.
This requires restrictions of file name syntax."
- (tramp-smb-file-name-p tramp-test-temporary-file-directory))
+ (tramp-smb-file-name-p ert-remote-temporary-file-directory))
(defun tramp--test-supports-processes-p ()
"Return whether the method under test supports external processes."
@@ -6450,8 +6790,8 @@ This requires restrictions of file name syntax."
;; Not all tramp-gvfs.el methods support changing the file mode.
(and
(tramp--test-gvfs-p)
- (string-match-p
- "ftp" (file-remote-p tramp-test-temporary-file-directory 'method)))))
+ (string-suffix-p
+ "ftp" (file-remote-p ert-remote-temporary-file-directory 'method)))))
(defun tramp--test-check-files (&rest files)
"Run a simple but comprehensive test over every file in FILES."
@@ -6462,8 +6802,8 @@ This requires restrictions of file name syntax."
;; We must use `file-truename' for the temporary directory,
;; because it could be located on a symlinked directory. This
;; would let the test fail.
- (let* ((tramp-test-temporary-file-directory
- (file-truename tramp-test-temporary-file-directory))
+ (let* ((ert-remote-temporary-file-directory
+ (file-truename ert-remote-temporary-file-directory))
(tramp-fuse-remove-hidden-files t)
(tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name 'local quoted))
@@ -6509,7 +6849,7 @@ This requires restrictions of file name syntax."
(string-equal
(funcall
(if quoted #'tramp-compat-file-name-quote #'identity)
- (tramp-compat-file-attribute-type (file-attributes file3)))
+ (file-attribute-type (file-attributes file3)))
(file-remote-p (file-truename file1) 'localname)))
;; Check file contents.
(with-temp-buffer
@@ -6540,7 +6880,7 @@ This requires restrictions of file name syntax."
(setq buffer (dired-noselect tmp-name1 "--dired -al"))
(goto-char (point-min))
(while (not (eobp))
- (when-let ((name (dired-get-filename 'localp 'no-error)))
+ (when-let ((name (dired-get-filename 'no-dir 'no-error)))
(unless
(string-match-p name directory-files-no-dot-files-regexp)
(should (member name files))))
@@ -6599,14 +6939,14 @@ This requires restrictions of file name syntax."
(should
(string-equal
(caar (directory-files-and-attributes
- file1 nil (regexp-quote elt1)))
+ file1 nil (tramp-compat-rx (literal elt1))))
elt1))
(should
(string-equal
(funcall
(if quoted #'tramp-compat-file-name-quote #'identity)
(cadr (car (directory-files-and-attributes
- file1 nil (regexp-quote elt1)))))
+ file1 nil (tramp-compat-rx (literal
elt1))))))
(file-remote-p (file-truename file2) 'localname)))
(delete-file file3)
(should-not (file-exists-p file3))))
@@ -6650,7 +6990,7 @@ This requires restrictions of file name syntax."
(dolist (elt files)
(let ((envvar (concat "VAR_" (upcase (md5 elt))))
(elt (encode-coding-string elt coding-system-for-read))
- (default-directory tramp-test-temporary-file-directory)
+ (default-directory ert-remote-temporary-file-directory)
(process-environment process-environment))
(setenv envvar elt)
;; The value of PS1 could confuse Tramp's detection
@@ -6661,18 +7001,23 @@ This requires restrictions of file name syntax."
(goto-char (point-min))
(should
(re-search-forward
- (format
- "^%s=%s$"
- (regexp-quote envvar)
- (regexp-quote (getenv envvar))))))))))
+ (tramp-compat-rx
+ bol (literal envvar)
+ "=" (literal (getenv envvar)) eol))))))))
;; Cleanup.
(ignore-errors (kill-buffer buffer))
(ignore-errors (delete-directory tmp-name1 'recursive))
(ignore-errors (delete-directory tmp-name2 'recursive))))))
-(defun tramp--test-special-characters ()
- "Perform the test in `tramp-test41-special-characters*'."
+;; These tests are inspired by Bug#17238.
+(ert-deftest tramp-test41-special-characters ()
+ "Check special characters in file names."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 245s
+ (skip-unless (not (tramp--test-rsync-p)))
+ (skip-unless (not (tramp--test-rclone-p)))
+
;; Newlines, slashes and backslashes in file names are not
;; supported. So we don't test. And we don't test the tab
;; character on Windows or Cygwin, because the backslash is
@@ -6729,80 +7074,24 @@ This requires restrictions of file name syntax."
(if (tramp--test-expensive-test-p)
files (list (mapconcat #'identity files ""))))))
-;; These tests are inspired by Bug#17238.
-(ert-deftest tramp-test41-special-characters ()
- "Check special characters in file names."
- (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 245s
- (skip-unless (tramp--test-enabled))
- (skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
+(tramp--test-deftest-with-stat tramp-test41-special-characters)
- (tramp--test-special-characters))
+(tramp--test-deftest-with-perl tramp-test41-special-characters)
-(ert-deftest tramp-test41-special-characters-with-stat ()
- "Check special characters in file names.
-Use the \"stat\" command."
- :tags '(:expensive-test)
- (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 287s
- (skip-unless (tramp--test-enabled))
- (skip-unless (tramp--test-sh-p))
- (skip-unless (not (tramp--test-rsync-p)))
- ;; We cannot use `tramp-test-vec', because this fails during compilation.
- (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
- (skip-unless (tramp-get-remote-stat v)))
-
- (let ((tramp-connection-properties
- (append
- `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
- "perl" nil))
- tramp-connection-properties)))
- (tramp--test-special-characters)))
-
-(ert-deftest tramp-test41-special-characters-with-perl ()
- "Check special characters in file names.
-Use the \"perl\" command."
- :tags '(:expensive-test)
- (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 266s
- (skip-unless (tramp--test-enabled))
- (skip-unless (tramp--test-sh-p))
- (skip-unless (not (tramp--test-rsync-p)))
- ;; We cannot use `tramp-test-vec', because this fails during compilation.
- (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
- (skip-unless (tramp-get-remote-perl v)))
-
- (let ((tramp-connection-properties
- (append
- `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
- "stat" nil)
- ;; See `tramp-sh-handle-file-truename'.
- (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
- "readlink" nil))
- tramp-connection-properties)))
- (tramp--test-special-characters)))
-
-(ert-deftest tramp-test41-special-characters-with-ls ()
- "Check special characters in file names.
-Use the \"ls\" command."
- :tags '(:expensive-test)
- (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 287s
+(tramp--test-deftest-with-ls tramp-test41-special-characters)
+
+(ert-deftest tramp-test42-utf8 ()
+ "Check UTF8 encoding in file names and file contents."
(skip-unless (tramp--test-enabled))
- (skip-unless (tramp--test-sh-p))
+ (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 620s
+ (skip-unless (not (tramp--test-docker-p)))
(skip-unless (not (tramp--test-rsync-p)))
+ (skip-unless (not (tramp--test-windows-nt-and-out-of-band-p)))
+ (skip-unless (not (tramp--test-ksh-p)))
+ (skip-unless (not (tramp--test-gdrive-p)))
+ (skip-unless (not (tramp--test-crypt-p)))
+ (skip-unless (not (tramp--test-rclone-p)))
- (let ((tramp-connection-properties
- (append
- `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
- "perl" nil)
- (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
- "stat" nil)
- ;; See `tramp-sh-handle-file-truename'.
- (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
- "readlink" nil))
- tramp-connection-properties)))
- (tramp--test-special-characters)))
-
-(defun tramp--test-utf8 ()
- "Perform the test in `tramp-test42-utf8*'."
(let* ((utf8 (if (and (eq system-type 'darwin)
(memq 'utf-8-hfs (coding-system-list)))
'utf-8-hfs 'utf-8))
@@ -6832,7 +7121,7 @@ Use the \"ls\" command."
;; Use all available language specific snippets.
(lambda (x)
(and
- (stringp (setq x (eval (get-language-info (car x) 'sample-text))))
+ (stringp (setq x (eval (get-language-info (car x) 'sample-text)
t)))
;; Filter out strings which use unencodable characters.
(not (and (or (tramp--test-gvfs-p) (tramp--test-smb-p))
(unencodable-char-position
@@ -6846,96 +7135,14 @@ Use the \"ls\" command."
;; ?\n and ?/ shouldn't be part of any file name. ?\t,
;; ?. and ?? do not work for "smb" method. " " does not
;; work at begin or end of the string for MS Windows.
- (replace-regexp-in-string "[ \t\n/.?]" "" x)))
+ (replace-regexp-in-string (rx (any " \t\n/.?")) "" x)))
language-info-alist)))))))
-(ert-deftest tramp-test42-utf8 ()
- "Check UTF8 encoding in file names and file contents."
- (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 620s
- (skip-unless (tramp--test-enabled))
- (skip-unless (not (tramp--test-docker-p)))
- (skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-windows-nt-and-out-of-band-p)))
- (skip-unless (not (tramp--test-ksh-p)))
- (skip-unless (not (tramp--test-gdrive-p)))
- (skip-unless (not (tramp--test-crypt-p)))
- (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
-
- (tramp--test-utf8))
+(tramp--test-deftest-with-stat tramp-test42-utf8)
-(ert-deftest tramp-test42-utf8-with-stat ()
- "Check UTF8 encoding in file names and file contents.
-Use the \"stat\" command."
- :tags '(:expensive-test)
- (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 595s
- (skip-unless (tramp--test-enabled))
- (skip-unless (tramp--test-sh-p))
- (skip-unless (not (tramp--test-docker-p)))
- (skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-out-of-band-p))) ; SLOW
- (skip-unless (not (tramp--test-ksh-p)))
- (skip-unless (not (tramp--test-crypt-p)))
- ;; We cannot use `tramp-test-vec', because this fails during compilation.
- (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
- (skip-unless (tramp-get-remote-stat v)))
-
- (let ((tramp-connection-properties
- (append
- `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
- "perl" nil))
- tramp-connection-properties)))
- (tramp--test-utf8)))
-
-(ert-deftest tramp-test42-utf8-with-perl ()
- "Check UTF8 encoding in file names and file contents.
-Use the \"perl\" command."
- :tags '(:expensive-test)
- (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 620s
- (skip-unless (tramp--test-enabled))
- (skip-unless (tramp--test-sh-p))
- (skip-unless (not (tramp--test-docker-p)))
- (skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-out-of-band-p))) ; SLOW
- (skip-unless (not (tramp--test-ksh-p)))
- (skip-unless (not (tramp--test-crypt-p)))
- ;; We cannot use `tramp-test-vec', because this fails during compilation.
- (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
- (skip-unless (tramp-get-remote-perl v)))
-
- (let ((tramp-connection-properties
- (append
- `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
- "stat" nil)
- ;; See `tramp-sh-handle-file-truename'.
- (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
- "readlink" nil))
- tramp-connection-properties)))
- (tramp--test-utf8)))
-
-(ert-deftest tramp-test42-utf8-with-ls ()
- "Check UTF8 encoding in file names and file contents.
-Use the \"ls\" command."
- :tags '(:expensive-test)
- (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 690s
- (skip-unless (tramp--test-enabled))
- (skip-unless (tramp--test-sh-p))
- (skip-unless (not (tramp--test-docker-p)))
- (skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-out-of-band-p))) ; SLOW
- (skip-unless (not (tramp--test-ksh-p)))
- (skip-unless (not (tramp--test-crypt-p)))
+(tramp--test-deftest-with-perl tramp-test42-utf8)
- (let ((tramp-connection-properties
- (append
- `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
- "perl" nil)
- (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
- "stat" nil)
- ;; See `tramp-sh-handle-file-truename'.
- (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory))
- "readlink" nil))
- tramp-connection-properties)))
- (tramp--test-utf8)))
+(tramp--test-deftest-with-ls tramp-test42-utf8)
(ert-deftest tramp-test43-file-system-info ()
"Check that `file-system-info' returns proper values."
@@ -6945,14 +7152,12 @@ Use the \"ls\" command."
;; `file-system-info' exists since Emacs 27.1. We don't want to see
;; compiler warnings for older Emacsen.
- (let ((fsi (with-no-warnings
- (file-system-info tramp-test-temporary-file-directory))))
- (skip-unless fsi)
- (should (and (consp fsi)
- (= (length fsi) 3)
- (numberp (nth 0 fsi))
- (numberp (nth 1 fsi))
- (numberp (nth 2 fsi))))))
+ (when-let ((fsi (with-no-warnings
+ (file-system-info ert-remote-temporary-file-directory))))
+ (should (consp fsi))
+ (should (= (length fsi) 3))
+ (dotimes (i (length fsi))
+ (should (natnump (or (nth i fsi) 0))))))
;; `tramp-test44-asynchronous-requests' could be blocked. So we set a
;; timeout of 300 seconds, and we send a SIGUSR1 signal after 300
@@ -6966,13 +7171,13 @@ The values are derived from PROC. Run BODY.
This is needed in timer functions as well as process filters and sentinels."
;; FIXME: For tramp-sshfs.el, `processp' does not work.
(declare (indent 1) (debug (processp body)))
- `(let* ((v (tramp-get-connection-property ,proc "vector" nil))
- (pname (tramp-get-connection-property v "process-name" nil))
- (pbuffer (tramp-get-connection-property v "process-buffer" nil)))
+ `(let* ((v (tramp-get-connection-property ,proc "vector"))
+ (pname (tramp-get-connection-property v "process-name"))
+ (pbuffer (tramp-get-connection-property v "process-buffer")))
(tramp--test-message
"tramp--test-with-proper-process-name-and-buffer before %s %s"
- (tramp-get-connection-property v "process-name" nil)
- (tramp-get-connection-property v "process-buffer" nil))
+ (tramp-get-connection-property v "process-name")
+ (tramp-get-connection-property v "process-buffer"))
(if (process-name ,proc)
(tramp-set-connection-property v "process-name" (process-name ,proc))
(tramp-flush-connection-property v "process-name"))
@@ -6982,8 +7187,8 @@ This is needed in timer functions as well as process
filters and sentinels."
(tramp-flush-connection-property v "process-buffer"))
(tramp--test-message
"tramp--test-with-proper-process-name-and-buffer changed %s %s"
- (tramp-get-connection-property v "process-name" nil)
- (tramp-get-connection-property v "process-buffer" nil))
+ (tramp-get-connection-property v "process-name")
+ (tramp-get-connection-property v "process-buffer"))
(unwind-protect
(progn ,@body)
(if pname
@@ -7073,11 +7278,7 @@ process sentinels. They shall not disturb each other."
(when buffers
(let ((time (float-time))
(default-directory tmp-name)
- (file
- (buffer-name
- ;; Use `seq-random-elt' once <26.1 support
- ;; is dropped.
- (nth (random (length buffers)) buffers)))
+ (file (buffer-name (seq-random-elt buffers)))
;; A remote operation in a timer could
;; confuse Tramp heavily. So we ignore this
;; error here.
@@ -7142,8 +7343,7 @@ process sentinels. They shall not disturb each other."
;; the buffers. Mix with regular operation.
(let ((buffers (copy-sequence buffers)))
(while buffers
- ;; Use `seq-random-elt' once <26.1 support is dropped.
- (let* ((buf (nth (random (length buffers)) buffers))
+ (let* ((buf (seq-random-elt buffers))
(proc (get-buffer-process buf))
(file (process-get proc 'foo))
(count (process-get proc 'bar)))
@@ -7196,11 +7396,113 @@ process sentinels. They shall not disturb each other."
(ignore-errors (cancel-timer timer))
(ignore-errors (delete-directory tmp-name 'recursive))))))
-;; (tramp--test--deftest-direct-async-process
tramp-test44-asynchronous-requests
-;; "Check parallel direct asynchronous requests." 'unstable)
+;; (tramp--test-deftest-direct-async-process tramp-test44-asynchronous-requests
+;; 'unstable)
+
+(ert-deftest tramp-test45-dired-compress-file ()
+ "Check that Tramp (un)compresses normal files."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (tramp--test-sh-p))
+ (skip-unless (not (tramp--test-crypt-p)))
+ ;; Starting with Emacs 29.1, `dired-compress-file' is performed by
+ ;; default handler.
+ (skip-unless (not (tramp--test-emacs29-p)))
+
+ (let ((default-directory ert-remote-temporary-file-directory)
+ (tmp-name (tramp--test-make-temp-name)))
+ (write-region "foo" nil tmp-name)
+ (dired default-directory)
+ (dired-revert)
+ (dired-goto-file tmp-name)
+ (should-not (dired-compress))
+ (should (string= (concat tmp-name ".gz") (dired-get-filename)))
+ (should-not (dired-compress))
+ (should (string= tmp-name (dired-get-filename)))
+ (delete-file tmp-name)))
+
+(ert-deftest tramp-test45-dired-compress-dir ()
+ "Check that Tramp (un)compresses directories."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (tramp--test-sh-p))
+ (skip-unless (not (tramp--test-crypt-p)))
+ ;; Starting with Emacs 29.1, `dired-compress-file' is performed by
+ ;; default handler.
+ (skip-unless (not (tramp--test-emacs29-p)))
+
+ (let ((default-directory ert-remote-temporary-file-directory)
+ (tmp-name (tramp--test-make-temp-name)))
+ (make-directory tmp-name)
+ (dired default-directory)
+ (dired-revert)
+ (dired-goto-file tmp-name)
+ (should-not (dired-compress))
+ (should (string= (concat tmp-name ".tar.gz") (dired-get-filename)))
+ (should-not (dired-compress))
+ (should (string= tmp-name (dired-get-filename)))
+ (delete-directory tmp-name)
+ (delete-file (concat tmp-name ".tar.gz"))))
+
+(ert-deftest tramp-test46-read-password ()
+ "Check Tramp password handling."
+ :tags '(:expensive-test)
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (tramp--test-mock-p))
+ ;; Not all read commands understand argument "-s" or "-p".
+ (skip-unless
+ (string-empty-p
+ (let ((shell-file-name "sh"))
+ (shell-command-to-string "read -s -p Password: pass"))))
+
+ (let ((pass "secret")
+ (mock-entry (copy-sequence (assoc "mock" tramp-methods)))
+ mocked-input tramp-methods)
+ ;; We must mock `read-string', in order to avoid interactive
+ ;; arguments.
+ (cl-letf* (((symbol-function #'read-string)
+ (lambda (&rest _args) (pop mocked-input))))
+ (setcdr
+ (assq 'tramp-login-args mock-entry)
+ `((("-c")
+ (,(tramp-shell-quote-argument
+ (concat
+ "read -s -p 'Password: ' pass; echo; "
+ "(test \"pass$pass\" != \"pass" pass "\" && "
+ "echo \"Login incorrect\" || sh -i)"))))))
+ (setq tramp-methods `(,mock-entry))
+
+ ;; Reading password from stdin works.
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug)
+ ;; We don't want to invalidate the password.
+ (setq mocked-input `(,(copy-sequence pass)))
+ (should (file-exists-p ert-remote-temporary-file-directory))
+
+ ;; Don't entering a password returns in error.
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug)
+ (setq mocked-input nil)
+ (should-error (file-exists-p ert-remote-temporary-file-directory))
+
+ ;; A wrong password doesn't work either.
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug)
+ (setq mocked-input `(,(concat pass pass)))
+ (should-error (file-exists-p ert-remote-temporary-file-directory))
+
+ ;; Reading password from auth-source works. We use the netrc
+ ;; backend; the other backends shall behave similar.
+ ;; Macro `ert-with-temp-file' was introduced in Emacs 29.1.
+ (with-no-warnings (when (symbol-plist 'ert-with-temp-file)
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug)
+ (setq mocked-input nil)
+ (auth-source-forget-all-cached)
+ (ert-with-temp-file netrc-file
+ :prefix "tramp-test" :suffix ""
+ :text (format
+ "machine %s port mock password %s"
+ (file-remote-p ert-remote-temporary-file-directory 'host) pass)
+ (let ((auth-sources `(,netrc-file)))
+ (should (file-exists-p ert-remote-temporary-file-directory)))))))))
;; This test is inspired by Bug#29163.
-(ert-deftest tramp-test45-auto-load ()
+(ert-deftest tramp-test47-auto-load ()
"Check that Tramp autoloads properly."
;; If we use another syntax but `default', Tramp is already loaded
;; due to the `tramp-change-syntax' call.
@@ -7213,10 +7515,10 @@ process sentinels. They shall not disturb each other."
;; Suppress method name check.
"(let ((non-essential t)) \
(message \"Tramp loaded: %%s\" (and (file-remote-p %S) t)))"
- tramp-test-temporary-file-directory)))
+ ert-remote-temporary-file-directory)))
(should
(string-match-p
- "Tramp loaded: t[\n\r]+"
+ (rx "Tramp loaded: t" (+ (any "\n\r")))
(shell-command-to-string
(format
"%s -batch -Q -L %s --eval %s"
@@ -7225,12 +7527,8 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
-(ert-deftest tramp-test45-delay-load ()
+(ert-deftest tramp-test47-delay-load ()
"Check that Tramp is loaded lazily, only when needed."
- ;; The autoloaded Tramp objects are different since Emacs 26.1. We
- ;; cannot test older Emacsen, therefore.
- (skip-unless (tramp--test-emacs26-p))
-
;; Tramp is neither loaded at Emacs startup, nor when completing a
;; non-Tramp file name like "/foo". Completing a Tramp-alike file
;; name like "/foo:" autoloads Tramp, when `tramp-mode' is t.
@@ -7247,9 +7545,10 @@ process sentinels. They shall not disturb each other."
(dolist (tm '(t nil))
(should
(string-match-p
- (format
- "Tramp loaded: nil[\n\r]+Tramp loaded: nil[\n\r]+Tramp loaded:
%s[\n\r]+"
- tm)
+ (tramp-compat-rx
+ "Tramp loaded: nil" (+ (any "\n\r"))
+ "Tramp loaded: nil" (+ (any "\n\r"))
+ "Tramp loaded: " (literal (symbol-name tm)) (+ (any "\n\r")))
(shell-command-to-string
(format
"%s -batch -Q -L %s --eval %s"
@@ -7258,7 +7557,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument (format code tm)))))))))
-(ert-deftest tramp-test45-recursive-load ()
+(ert-deftest tramp-test47-recursive-load ()
"Check that Tramp does not fail due to recursive load."
(skip-unless (tramp--test-enabled))
@@ -7266,10 +7565,10 @@ process sentinels. They shall not disturb each other."
(dolist (code
(list
(format
- "(expand-file-name %S)" tramp-test-temporary-file-directory)
+ "(expand-file-name %S)" ert-remote-temporary-file-directory)
(format
"(let ((default-directory %S)) (expand-file-name %S))"
- tramp-test-temporary-file-directory
+ ert-remote-temporary-file-directory
temporary-file-directory)))
(should-not
(string-match-p
@@ -7282,12 +7581,8 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code))))))))
-(ert-deftest tramp-test45-remote-load-path ()
+(ert-deftest tramp-test47-remote-load-path ()
"Check that Tramp autoloads its packages with remote `load-path'."
- ;; The autoloaded Tramp objects are different since Emacs 26.1. We
- ;; cannot test older Emacsen, therefore.
- (skip-unless (tramp--test-emacs26-p))
-
;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el.
;; It shall still work, when a remote file name is in the
;; `load-path'.
@@ -7298,9 +7593,9 @@ process sentinels. They shall not disturb each other."
(tramp-cleanup-all-connections))"))
(should
(string-match-p
- (format
- "Loading %s"
- (regexp-quote
+ (tramp-compat-rx
+ "Loading "
+ (literal
(expand-file-name
"tramp-cmds" (file-name-directory (locate-library "tramp")))))
(shell-command-to-string
@@ -7311,14 +7606,10 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
-(ert-deftest tramp-test46-unload ()
+(ert-deftest tramp-test48-unload ()
"Check that Tramp and its subpackages unload completely.
Since it unloads Tramp, it shall be the last test to run."
:tags '(:expensive-test)
- ;; The autoloaded Tramp objects are different since Emacs 26.1. We
- ;; cannot test older Emacsen, therefore.
- (skip-unless (tramp--test-emacs26-p))
-
;; We have autoloaded objects from tramp.el and tramp-archive.el.
;; In order to remove them, we first need to load both packages.
(require 'tramp)
@@ -7347,11 +7638,16 @@ Since it unloads Tramp, it shall be the last test to
run."
(and (or (and (boundp x) (null (local-variable-if-set-p x)))
(and (functionp x) (null (autoloadp (symbol-function x))))
(macrop x))
- (string-match-p "^tramp" (symbol-name x))
+ (string-prefix-p "tramp" (symbol-name x))
;; `tramp-completion-mode' is autoloaded in Emacs < 28.1.
(not (eq 'tramp-completion-mode x))
- (not (string-match-p "^tramp\\(-archive\\)?--?test" (symbol-name x)))
- (not (string-match-p "unload-hook$" (symbol-name x)))
+ ;; `tramp-register-archive-file-name-handler' is autoloaded
+ ;; in Emacs < 29.1.
+ (not (eq 'tramp-register-archive-file-name-handler x))
+ (not (string-match-p
+ (rx bol "tramp" (? "-archive") (** 1 2 "-") "test")
+ (symbol-name x)))
+ (not (string-suffix-p "unload-hook" (symbol-name x)))
(not (get x 'tramp-autoload))
(ert-fail (format "`%s' still bound" x)))))
@@ -7361,7 +7657,7 @@ Since it unloads Tramp, it shall be the last test to run."
(mapatoms
(lambda (x)
(and (functionp x) (null (autoloadp (symbol-function x)))
- (string-match-p "tramp-file-name" (symbol-name x))
+ (string-prefix-p "tramp-file-name" (symbol-name x))
(ert-fail (format "Structure function `%s' still exists" x)))))
;; There shouldn't be left a hook function containing a Tramp
@@ -7369,8 +7665,9 @@ Since it unloads Tramp, it shall be the last test to run."
(mapatoms
(lambda (x)
(and (boundp x)
- (string-match-p "-\\(hook\\|function\\)s?$" (symbol-name x))
- (not (string-match-p "unload-hook$" (symbol-name x)))
+ (string-match-p
+ (rx "-" (| "hook" "function") (? "s") eol) (symbol-name x))
+ (not (string-suffix-p "unload-hook" (symbol-name x)))
(consp (symbol-value x))
(ignore-errors (all-completions "tramp" (symbol-value x)))
(ert-fail (format "Hook `%s' still contains Tramp function" x)))))
@@ -7381,7 +7678,7 @@ Since it unloads Tramp, it shall be the last test to run."
(and (functionp x)
(advice-mapc
(lambda (fun _symbol)
- (and (string-match-p "^tramp" (symbol-name fun))
+ (and (string-prefix-p "tramp" (symbol-name fun))
(ert-fail
(format "Function `%s' still contains Tramp advice" x))))
x))))
@@ -7398,24 +7695,25 @@ If INTERACTIVE is non-nil, the tests are run
interactively."
(interactive "p")
(funcall
(if interactive #'ert-run-tests-interactively #'ert-run-tests-batch)
- "^tramp"))
+ (rx bol "tramp")))
;; TODO:
-;; * dired-compress-file
-;; * dired-uncache
+;; * dired-uncache (partly done in other test functions)
;; * file-equal-p (partly done in `tramp-test21-file-links')
;; * file-in-directory-p
;; * file-name-case-insensitive-p
;; * tramp-get-remote-gid
+;; * tramp-get-remote-groups
;; * tramp-get-remote-uid
;; * tramp-set-file-uid-gid
;; * Work on skipped tests. Make a comment, when it is impossible.
;; * Revisit expensive tests, once problems in `tramp-error' are solved.
;; * Fix `tramp-test06-directory-file-name' for "ftp".
-;; * Implement `tramp-test31-interrupt-process' for "adb", "sshfs" and
-;; for direct async processes.
+;; * Implement `tramp-test31-interrupt-process' and
+;; `tramp-test31-signal-process' for "adb", "sshfs" and for direct
+;; async processes. Check, why they don't run stable.
;; * Check, why direct async processes do not work for
;; `tramp-test44-asynchronous-requests'.
diff --git a/texi/tramp.texi b/texi/tramp.texi
index ce04ed20dd..80874049fa 100644
--- a/texi/tramp.texi
+++ b/texi/tramp.texi
@@ -2,8 +2,8 @@
@setfilename ../info/tramp
@c %**start of header
@include docstyle.texi
-@c In the Tramp GIT, the version number is auto-frobbed from tramp.el,
-@c and the bug report address is auto-frobbed from configure.ac.
+@c In the Tramp GIT, the version number and the bug report address
+@c are auto-frobbed from configure.ac.
@include trampver.texi
@settitle @value{tramp} @value{trampver} User Manual
@c %**end of header
@@ -50,13 +50,10 @@ This file documents @w{@value{tramp} @value{trampver}}, a
remote file
editing package for Emacs.
@value{tramp} stands for ``Transparent Remote (file) Access, Multiple
-Protocol''. This package provides remote file editing, similar to
-Ange FTP@.
-
-The difference is that Ange FTP uses FTP to transfer files between the
-local and the remote host, whereas @value{tramp} uses a combination of
-@command{rsh} and @command{rcp} or other work-alike programs, such as
-@command{ssh}/@command{scp}.
+Protocol''. This package provides an easy, convenient, and consistent
+interface to editing remote files transparently, just as if they are
+local files. This extends to editing, version control, @code{dired},
+and more.
You can find the latest version of this document on the web at
@uref{@value{trampurl}}.
@@ -133,19 +130,21 @@ Configuring @value{tramp} for use
* Multi-hops:: Connecting to a remote host using multiple
hops.
* Firewalls:: Passing firewalls.
* Customizing Methods:: Using Non-Standard Methods.
-* Customizing Completion:: Selecting config files for user/host name
completion.
+* Customizing Completion:: Selecting config files for user/host name @c
+completion.
* Password handling:: Reusing passwords for several connections.
* Connection caching:: Reusing connection related information.
* Predefined connection information::
Setting own connection related information.
-* Remote programs:: How @value{tramp} finds and uses programs on
the remote host.
+* Remote programs:: How @value{tramp} finds and uses programs @c
+on the remote host.
* Remote shell setup:: Remote shell setup hints.
+* Ssh setup:: Ssh setup hints.
* FUSE setup:: @acronym{FUSE} setup hints.
* Android shell setup:: Android shell setup hints.
* Auto-save File Lock and Backup::
Auto-save, File Lock and Backup.
* Keeping files encrypted:: Protect remote files by encryption.
-* Windows setup hints:: Issues with Cygwin ssh.
Using @value{tramp}
@@ -155,6 +154,7 @@ Using @value{tramp}
@end ifset
* File name completion:: File name completion.
* Ad-hoc multi-hops:: Declaring multiple hops in the file name.
+* Home directories:: Expanding @file{~} to home directory.
* Remote processes:: Integration with other Emacs packages.
* Cleanup remote connections:: Cleanup remote connections.
* Renaming remote files:: Renaming remote files.
@@ -179,10 +179,10 @@ interface to remote files as if they are local files.
@value{tramp}'s
transparency extends to editing, version control, and @code{dired}.
@value{tramp} can access remote hosts using any number of access
-methods, such as @command{rsh}, @command{rlogin}, @command{telnet},
-and related programs. If these programs can successfully pass
-@acronym{ASCII} characters, @value{tramp} can use them.
-@value{tramp} does not require or mandate 8-bit clean connections.
+methods, such as @command{ssh}, @command{scp}, @command{telnet}, and
+related programs. If these programs can successfully pass
+@acronym{ASCII} characters, @value{tramp} can use them. @value{tramp}
+does not require or mandate 8-bit clean connections.
@value{tramp}'s most common access method is through @command{ssh}, a
more secure alternative to @command{ftp} and other older access
@@ -230,10 +230,10 @@ first time connecting to that host, here's what happens:
@itemize
@item
-@value{tramp} invokes @samp{telnet @var{host}} or @samp{rsh @var{host}
--l @var{user}} and establishes an external process to connect to the
-remote host. @value{tramp} communicates with the process through an
-Emacs buffer, which also shows output from the remote host.
+@value{tramp} invokes @samp{telnet @var{host}} or @samp{ssh -l
+@var{user} @var{host}} and establishes an external process to connect
+to the remote host. @value{tramp} communicates with the process
+through an Emacs buffer, which also shows output from the remote host.
@item
The remote host may prompt for a login name (for @command{telnet}, for
@@ -243,7 +243,7 @@ followed by a newline.
@item
The remote host may then prompt for a password or passphrase (for
-@command{rsh} or for @command{telnet}). @value{tramp} displays the
+@command{ssh} or for @command{telnet}). @value{tramp} displays the
password prompt in the minibuffer. @value{tramp} then sends whatever
is entered to the remote host, followed by a newline.
@@ -309,7 +309,7 @@ I hope this has provided you with a basic overview of what
happens
behind the scenes when you open a file with @value{tramp}.
-@c For the end user
+@c For the end user.
@node Obtaining @value{tramp}
@chapter Obtaining @value{tramp}
@cindex obtaining @value{tramp}
@@ -523,7 +523,7 @@ performed on another host, it can be comnbined with a
leading
connects first to the other host with non-administrative credentials,
and changes to administrative credentials on that host afterwards. In
a simple case, the syntax looks like
-@file{@value{prefix}ssh@value{postfixhop}user@@host|sudo@value{postfixhop}@value{postfix}/path/to/file}.
+@file{@trampfn{ssh@value{postfixhop}user@@host|sudo,,/path/to/file}}.
@xref{Ad-hoc multi-hops}.
@@ -688,19 +688,21 @@ to non-@code{nil}, @xref{Directory Variables, , , emacs}.
* Multi-hops:: Connecting to a remote host using multiple
hops.
* Firewalls:: Passing firewalls.
* Customizing Methods:: Using Non-Standard Methods.
-* Customizing Completion:: Selecting config files for user/host name
completion.
+* Customizing Completion:: Selecting config files for user/host name @c
+completion.
* Password handling:: Reusing passwords for several connections.
* Connection caching:: Reusing connection related information.
* Predefined connection information::
Setting own connection related information.
-* Remote programs:: How @value{tramp} finds and uses programs on
the remote host.
+* Remote programs:: How @value{tramp} finds and uses programs @c
+on the remote host.
* Remote shell setup:: Remote shell setup hints.
+* Ssh setup:: Ssh setup hints.
* FUSE setup:: @acronym{FUSE} setup hints.
* Android shell setup:: Android shell setup hints.
* Auto-save File Lock and Backup::
Auto-save, File Lock and Backup.
* Keeping files encrypted:: Protect remote files by encryption.
-* Windows setup hints:: Issues with Cygwin ssh.
@end menu
@@ -901,6 +903,30 @@ supports changing the remote login shell @command{/bin/sh}.
Check the @samp{Share SSH connections if possible} control for that
session.
+@item @option{docker}
+@cindex method @option{docker}
+@cindex @option{docker} method
+
+Integration for Docker containers. The host name may be either a
+running container's name or ID, as returned by @samp{docker ps}.
+
+@item @option{podman}
+@cindex method @option{podman}
+@cindex @option{podman} method
+
+Podman is an alternative to @option{docker} which may be run rootless,
+if desired.
+
+@item @option{kubernetes}
+@cindex method @option{kubernetes}
+@cindex @option{kubernetes} method
+
+Integration for containers in Kubernetes pods. The host name is a pod
+name returned by @samp{kubectl get pods}. The first container in a
+pod is used.
+
+This method does not support user names.
+
@end table
@@ -1239,7 +1265,8 @@ be populated in your @command{Online Accounts}
application outside Emacs.
Since Google Drive uses cryptic blob file names internally,
@value{tramp} works with the @code{display-name} of the files. This
could produce unexpected behavior in case two files in the same
-directory have the same @code{display-name}, such a situation must be avoided.
+directory have the same @code{display-name}, such a situation must be
+avoided.
@item @option{mtp}
@cindex method @option{mtp}
@@ -1453,7 +1480,7 @@ External methods might be more efficient for large files,
but most
@value{tramp} users edit small files more often than large files.
Enable compression, @code{tramp-inline-compress-start-size}, for a
-performance boost for large files.
+performance boost for large files with inline methods.
Since @command{ssh} has become the most common method of remote host
access and it has the most reasonable security protocols, use
@@ -1479,6 +1506,10 @@ For editing large files, @option{scp} is faster than
@option{ssh}.
@option{pscp} is faster than @option{plink}. But this speed
improvement is not always true.
+When copying large files between two different remote hosts via
+@option{scp}, set @code{tramp-use-scp-direct-remote-copying} to
+non-@code{nil}.
+
@node Default User
@section Selecting a default user
@@ -1659,7 +1690,7 @@ local one, first connect via @command{ssh}, and then apply
(add-to-list 'tramp-default-proxies-alist
'(nil "\\`root\\'" "@trampfn{ssh,%h,}"))
(add-to-list 'tramp-default-proxies-alist
- '((regexp-quote (system-name)) nil nil))
+ `(,(regexp-quote (system-name)) nil nil))
@end group
@end lisp
@end defopt
@@ -1694,8 +1725,8 @@ Sometimes, it is not possible to reach a remote host
directly. A
firewall might be in the way, which could be passed via a proxy
server.
-Both ssh and PuTTY support such proxy settings, using an HTTP tunnel
-via the @command{CONNECT} command (conforming to RFC 2616, 2817
+Both OpenSSH and PuTTY support such proxy settings, using an HTTP
+tunnel via the @command{CONNECT} command (conforming to RFC 2616, 2817
specifications). Proxy servers using HTTP 1.1 or later protocol
support this command.
@@ -1756,36 +1787,21 @@ They can be installed with Emacs's Package Manager.
This includes
@c @item ibuffer-tramp.el
@c Contact Svend Sorensen <svend@@ciffer.net>
-@item docker-tramp
-@cindex method @option{docker}
-@cindex @option{docker} method
-Integration for Docker containers. A container is accessed via
-@file{@trampfn{docker,user@@container,/path/to/file}}, where
-@samp{user} is the (optional) user that you want to use, and
-@samp{container} is the id or name of the container.
-
-@item kubernetes-tramp
-@cindex method @option{kubectl}
-@cindex @option{kubectl} method
-Integration for Docker containers deployed in a Kubernetes cluster.
-It is derived from @samp{docker-tramp}. A container is accessed via
-@file{@trampfn{kubectl,user@@container,/path/to/file}}, @samp{user}
-and @samp{container} have the same meaning as in @samp{docker-tramp}.
-
@item lxc-tramp
@cindex method @option{lxc}
@cindex @option{lxc} method
Integration for LXC containers. A container is accessed via
@file{@trampfn{lxc,container,/path/to/file}}, @samp{container} has the
-same meaning as in @samp{docker-tramp}. A @samp{user} specification
-is ignored.
+same meaning as with the @option{docker} method. A @samp{user}
+specification is ignored.
@item lxd-tramp
@cindex method @option{lxd}
@cindex @option{lxd} method
Integration for LXD containers. A container is accessed via
@file{@trampfn{lxd,user@@container,/path/to/file}}, @samp{user} and
-@samp{container} have the same meaning as in @samp{docker-tramp}.
+@samp{container} have the same meaning as with the @option{docker}
+method.
@item magit-tramp
@cindex method @option{git}
@@ -1804,12 +1820,23 @@ Access of a hadoop/hdfs file system. A file is
accessed via
the user that you want to use, and @samp{node} is the name of the
hadoop server.
+@item tramp-nspawn
+@cindex method @option{nspawn}
+@cindex @option{nspawn} method
+Access to environments provided by systemd-nspawn. A file is accessed
+via @file{@trampfn{nspawn,user@@container,/path/to/file}}, where
+@samp{user} is the (optional) user that you want to use, and
+@samp{container} is the container to connect to. systemd-nspawn and
+its container utilities often require super user access to run, use
+multi-hop file names with @option{doas} or @option{sudo} to raise your
+privileges.
+
@item vagrant-tramp
@cindex method @option{vagrant}
@cindex @option{vagrant} method
Convenience method to access vagrant boxes. It is often used in
multi-hop file names like
-@file{@value{prefix}vagrant@value{postfixhop}box|sudo@value{postfixhop}box@value{postfix}/path/to/file},
+@file{@trampfn{vagrant@value{postfixhop}box|sudo,box,/path/to/file}},
where @samp{box} is the name of the vagrant box.
@end table
@@ -1865,29 +1892,25 @@ Example:
The following predefined functions parsing configuration files exist:
-@table @asis
+@ftable @asis
@item @code{tramp-parse-rhosts}
-@findex tramp-parse-rhosts
This function parses files which are syntactical equivalent to
@file{~/.rhosts}. It returns both host names and user names, if
specified.
@item @code{tramp-parse-shosts}
-@findex tramp-parse-shosts
This function parses files which are syntactical equivalent to
@file{~/.ssh/known_hosts}. Since there are no user names specified
in such files, it can return host names only.
@item @code{tramp-parse-sconfig}
-@findex tramp-parse-sconfig
This function returns the host nicknames defined by @option{Host}
entries in @file{~/.ssh/config} style files.
@item @code{tramp-parse-shostkeys}
-@findex tramp-parse-shostkeys
SSH2 parsing of directories @file{/etc/ssh2/hostkeys/*} and
@file{~/ssh2/hostkeys/*}. Hosts are coded in file names
@@ -1895,7 +1918,6 @@ SSH2 parsing of directories @file{/etc/ssh2/hostkeys/*}
and
are always @code{nil}.
@item @code{tramp-parse-sknownhosts}
-@findex tramp-parse-sknownhosts
Another SSH2 style parsing of directories like
@file{/etc/ssh2/knownhosts/*} and @file{~/ssh2/knownhosts/*}. This
@@ -1903,26 +1925,22 @@ case, hosts names are coded in file names
@file{@var{host-name}.@var{algorithm}.pub}. User names are always @code{nil}.
@item @code{tramp-parse-hosts}
-@findex tramp-parse-hosts
A function dedicated to @file{/etc/hosts} for host names.
@item @code{tramp-parse-passwd}
-@findex tramp-parse-passwd
A function which parses @file{/etc/passwd} for user names.
@item @code{tramp-parse-etc-group}
-@findex tramp-parse-etc-group
A function which parses @file{/etc/group} for group names.
@item @code{tramp-parse-netrc}
-@findex tramp-parse-netrc
A function which parses @file{~/.netrc} and @file{~/.authinfo}-style files.
-@end table
+@end ftable
To keep a custom file with custom data in a custom structure, a custom
function has to be provided. This function must meet the following
@@ -1982,6 +2000,20 @@ file name syntax, must be appended to the machine and
login items:
machine melancholia#4711 port davs login daniel%BIZARRE password geheim
@end example
+For the methods @option{doas}, @option{sudo} and @option{sudoedit} the
+password of the user requesting the connection is needed, and not the
+password of the target user. If these connections happen on the local
+host, an entry with the local user and local host is used:
+
+@example
+machine @var{host} port sudo login @var{user} password secret
+@end example
+
+@var{user} and @var{host} are the strings returned by
+@code{(user-login-name)} and @code{(system-name)}. If one of these
+methods is connected via a multi hop (@pxref{Multi-hops}), the
+credentials of the previous hop are used.
+
@vindex auth-source-save-behavior
If no proper entry exists, the password is read
interactively. After successful login (verification of the password),
@@ -2147,6 +2179,14 @@ reestablished. A value of @code{nil} disables this
feature. Most of
the methods do not set this property except the @option{sudo} and
@option{doas} methods, which use predefined values.
+@item @t{"~"}@*
+@t{"~user"}
+
+This is the home directory on the remote host. Setting this
+connection property helps especially for methods which cannot expand
+to a remote home directory, like @option{adb}, @option{rclone} and
+@option{sshfs}. @ref{Home directories} for an example.
+
@item @t{"tmpdir"}
The temporary directory on the remote host. If not specified, the
@@ -2243,8 +2283,7 @@ preserves the path value, which can be used to update
shell supports the login argument @samp{-l}.
@end defopt
-Starting with @w{Emacs 26}, @code{tramp-remote-path} can be set per
-host via connection-local
+@code{tramp-remote-path} can also be set per host via connection-local
@ifinfo
variables, @xref{Connection Variables, , , emacs}.
@end ifinfo
@@ -2612,6 +2651,246 @@ where @samp{192.168.0.1} is the remote host IP address
@end table
+@node Ssh setup
+@section Ssh setup hints
+
+The most common @value{tramp} connection family is based on either
+@command{ssh} or @command{scp} of OpenSSH, or @command{plink} or
+@command{pscp} of PuTTY on MS Windows. In the following, some
+configuration recommendations are given.
+
+
+@subsection Using ssh config include for host name completion
+
+@vindex Include@r{, ssh option}
+@findex tramp-set-completion-function
+@findex tramp-get-completion-function
+OpenSSH configuration files can use an @option{Include} option for
+further configuration files. Default @value{tramp} host name
+completion ignores this option. However, you can configure this
+yourself.
+
+Given, your @file{~/.ssh/config} file contains the following option:
+
+@example
+Include ~/.ssh/conf.d/*
+@end example
+
+The following code snippet in your @file{.emacs} uses all files in
+that directory for host name completion:
+
+@lisp
+@group
+(tramp-set-completion-function
+ "ssh" (append (tramp-get-completion-function "ssh")
+ (mapcar (lambda (file) `(tramp-parse-sconfig ,file))
+ (directory-files
+ "~/.ssh/conf.d/"
+ 'full directory-files-no-dot-files-regexp))))
+@end group
+@end lisp
+
+This code snippet does it for the @option{ssh} method. If you replace
+@t{"ssh"} by @t{"scp"}, it does it also for that method (or any other
+method you like).
+
+
+@subsection Detection of session hangouts
+
+@vindex ServerAliveInterval@r{, ssh option}
+@vindex ServerAliveCountMax@r{, ssh option}
+@command{ssh} sessions on the local host hang when the network is
+down. @value{tramp} cannot safely detect such hangs. OpenSSH can be
+configured to kill such hangs with the following settings in
+@file{~/.ssh/config}:
+
+@example
+@group
+Host *
+ ServerAliveInterval 5
+ ServerAliveCountMax 2
+@end group
+@end example
+
+The corresponding PuTTY configuration is in the @option{Connection}
+entry, @option{Seconds between keepalives} option. Set this to 5.
+There is no counter which could be set.
+
+
+@subsection Using ssh connection sharing
+
+@vindex ControlPath@r{, ssh option}
+@vindex ControlPersist@r{, ssh option}
+@value{tramp} uses the @option{ControlMaster=auto} OpenSSH option by
+default, if possible. However, it overwrites @option{ControlPath}
+settings when initiating @command{ssh} sessions. @value{tramp} does
+this to fend off a stall if a master session opened outside the Emacs
+session is no longer open. That is why @value{tramp} prompts for the
+password again even if there is an @command{ssh} already open.
+
+@vindex tramp-ssh-controlmaster-options
+Some OpenSSH versions support a @option{ControlPersist} option, which
+allows you to set the @option{ControlPath} provided the variable
+@code{tramp-ssh-controlmaster-options} is customized as follows:
+
+@lisp
+@group
+(customize-set-variable
+ 'tramp-ssh-controlmaster-options
+ (concat
+ "-o ControlPath=/tmp/ssh-ControlPath-%%r@@%%h:%%p "
+ "-o ControlMaster=auto -o ControlPersist=yes"))
+@end group
+@end lisp
+
+Note how @samp{%r}, @samp{%h} and @samp{%p} must be encoded as
+@samp{%%r}, @samp{%%h} and @samp{%%p}.
+
+@vindex tramp-use-ssh-controlmaster-options
+If the @file{~/.ssh/config} file is configured appropriately for the
+above behavior, then any changes to @command{ssh} can be suppressed
+with this @code{nil} setting:
+
+@lisp
+(customize-set-variable 'tramp-use-ssh-controlmaster-options nil)
+@end lisp
+
+@vindex ProxyCommand@r{, ssh option}
+@vindex ProxyJump@r{, ssh option}
+This should also be set to @code{nil} if you use the
+@option{ProxyCommand} or @option{ProxyJump} options in your
+@command{ssh} configuration.
+
+In order to use the @option{ControlMaster} option, @value{tramp} must
+check whether the @command{ssh} client supports this option. This is
+only possible on the local host, for the first hop. @value{tramp}
+does not use this option on proxy hosts, therefore.
+
+If you want to use this option also for the other hops, you must
+configure @file{~/.ssh/config} on the proxy host:
+
+@example
+@group
+Host *
+ ControlMaster auto
+ ControlPath tramp.%C
+ ControlPersist no
+@end group
+@end example
+
+Check the @samp{ssh_config(5)} man page whether these options are
+supported on your proxy host.
+
+On MS Windows, @code{tramp-use-ssh-controlmaster-options} is set to
+@code{nil} by default, because the MS Windows and MSYS2
+implementations of @command{OpenSSH} do not support this option properly.
+
+In PuTTY, you can achieve connection sharing in the @option{Connection/SSH}
+entry, enabling the @option{Share SSH connections if possible} option.
+
+
+@subsection Configure direct copying between two remote servers
+
+@vindex tramp-use-scp-direct-remote-copying
+@value{tramp} uses a temporary local copy when copying two files
+between different remote hosts via external methods. This behavior is
+due to authentication problems @value{tramp} cannot handle
+sufficiently. However, for @option{scp} connections this can be
+changed. When a file shall be copied between two different remote
+hosts @samp{source} and @samp{target}, and
+
+@itemize @minus
+@item
+Variable @code{tramp-use-scp-direct-remote-copying} is non-@code{nil},
+
+@item
+Remote host @samp{source} doesn't use the @option{RemoteCommand}
+option in @file{~/.ssh/config},
+
+@item
+Remote host @samp{target} shows the same host key when seen from the
+local host and from host @samp{source}, and
+
+@item
+@command{scp} running on host @samp{source} can authenticate to host
+@samp{target} without requiring a password,
+@end itemize
+
+@noindent
+@value{tramp} applies direct remote copying between hosts
+@samp{source} and @samp{target} like
+
+@example
+scp -p -T -R -q -r source:/path/to/file target:/path/to/another/file
+@end example
+
+This protects also your local temporary directory from overrun when
+copying large files.
+
+If these conditions do not apply, and
+@code{tramp-use-scp-direct-remote-copying} is non-@code{nil}, the
+option @samp{-3} is used instead of @samp{-R}.
+
+@c FIXME
+When @value{tramp} uses direct remote copying, password caches are not
+consulted.
+
+
+@subsection Issues with Cygwin ssh
+@cindex cygwin, issues
+
+This section is incomplete. Please share your solutions.
+
+@cindex method @option{sshx} with cygwin
+@cindex @option{sshx} method with cygwin
+
+Cygwin's @command{ssh} works only with a Cygwin version of Emacs. To
+check for compatibility: type @kbd{M-x eshell @key{RET}}, and start
+@kbd{ssh test.host @key{RET}}. Incompatibilities trigger this
+message:
+
+@example
+Pseudo-terminal will not be allocated because stdin is not a terminal.
+@end example
+
+Some older versions of Cygwin's @command{ssh} work with the
+@option{sshx} access method. Consult Cygwin's FAQ at
+@uref{https://cygwin.com/faq/} for details.
+
+@cindex cygwin and @command{fakecygpty}
+@cindex @command{fakecygpty} and cygwin
+
+On @uref{https://www.emacswiki.org/emacs/SshWithNTEmacs, the Emacs
+Wiki} it is explained how to use the helper program
+@command{fakecygpty} to fix this problem.
+
+@cindex method @option{scpx} with cygwin
+@cindex @option{scpx} method with cygwin
+
+When using the @option{scpx} access method, Emacs may call
+@command{scp} with MS Windows file naming, such as @file{c:/foo}. But
+the version of @command{scp} that is installed with Cygwin does not
+know about MS Windows file naming, which causes it to incorrectly look
+for a host named @samp{c}.
+
+A workaround: write a wrapper script for @option{scp} to convert
+Windows file names to Cygwin file names.
+
+@cindex cygwin and @command{ssh-agent}
+@cindex @env{SSH_AUTH_SOCK} and emacs on ms windows
+@vindex SSH_AUTH_SOCK@r{, environment variable}
+
+When using the @command{ssh-agent} on MS Windows for password-less
+interaction, @option{ssh} methods depend on the environment variable
+@env{SSH_AUTH_SOCK}. But this variable is not set when Emacs is
+started from a Desktop shortcut and authentication fails.
+
+One workaround is to use an MS Windows based SSH Agent, such as
+@command{Pageant}. It is part of the PuTTY Suite of tools.
+
+The fallback is to start Emacs from a shell.
+
+
@node FUSE setup
@section @acronym{FUSE} setup hints
@@ -2671,6 +2950,7 @@ Additionally, it declares also the arguments for running
remote
processes, using the @command{ssh} command. These don't need to be
changed.
+
@node Android shell setup
@section Android shell setup hints
@cindex android shell setup for ssh
@@ -2859,10 +3139,10 @@ Example:
The backup file name of
@file{@trampfn{su,root@@localhost,/etc/secretfile}} would be
@ifset unified
-@file{@trampfn{su,root@@localhost,~/.emacs.d/backups/!su:root@@localhost:!etc!secretfile~}}
+@file{@trampfn{su,root@@localhost,~/.emacs.d/backups/!su:root@@localhost:!etc!secretfile~}}.
@end ifset
@ifset separate
-@file{@trampfn{su,root@@localhost,~/.emacs.d/backups/![su!root@@localhost]!etc!secretfile~}}
+@file{@trampfn{su,root@@localhost,~/.emacs.d/backups/![su!root@@localhost]!etc!secretfile~}}.
@end ifset
@vindex auto-save-file-name-transforms
@@ -2880,6 +3160,14 @@ auto-saved files to the same directory as the original
file.
Alternatively, set the user option @code{tramp-auto-save-directory}
to direct all auto saves to that location.
+@c Since Emacs 29.
+@vindex remote-file-name-inhibit-auto-save-visited
+An alternative to @code{auto-save-mode} is
+@code{auto-save-visited-mode}. In this mode, auto-saving is identical
+to explicit saving. If you want to disable this behavior for remote
+files, set user option
+@code{remote-file-name-inhibit-auto-save-visited} to non-@code{nil}.
+
@vindex lock-file-name-transforms
And still more issues to handle. Since @w{Emacs 28}, file locks use a
similar user option as auto-save files, called
@@ -3016,62 +3304,6 @@ subdirectories will remain encrypted.
@end deffn
-@node Windows setup hints
-@section Issues with Cygwin ssh
-@cindex cygwin, issues
-
-This section is incomplete. Please share your solutions.
-
-@cindex method @option{sshx} with cygwin
-@cindex @option{sshx} method with cygwin
-
-Cygwin's @command{ssh} works only with a Cygwin version of Emacs. To
-check for compatibility: type @kbd{M-x eshell @key{RET}}, and start
-@kbd{ssh test.host @key{RET}}. Incompatibilities trigger this
-message:
-
-@example
-Pseudo-terminal will not be allocated because stdin is not a terminal.
-@end example
-
-Some older versions of Cygwin's @command{ssh} work with the
-@option{sshx} access method. Consult Cygwin's FAQ at
-@uref{https://cygwin.com/faq/} for details.
-
-@cindex cygwin and @command{fakecygpty}
-@cindex @command{fakecygpty} and cygwin
-
-On @uref{https://www.emacswiki.org/emacs/SshWithNTEmacs, the Emacs
-Wiki} it is explained how to use the helper program
-@command{fakecygpty} to fix this problem.
-
-@cindex method @option{scpx} with cygwin
-@cindex @option{scpx} method with cygwin
-
-When using the @option{scpx} access method, Emacs may call
-@command{scp} with MS Windows file naming, such as @file{c:/foo}. But
-the version of @command{scp} that is installed with Cygwin does not
-know about MS Windows file naming, which causes it to incorrectly look
-for a host named @samp{c}.
-
-A workaround: write a wrapper script for @option{scp} to convert
-Windows file names to Cygwin file names.
-
-@cindex cygwin and @command{ssh-agent}
-@cindex @env{SSH_AUTH_SOCK} and emacs on ms windows
-@vindex SSH_AUTH_SOCK@r{, environment variable}
-
-When using the @command{ssh-agent} on MS Windows for password-less
-interaction, @option{ssh} methods depend on the environment variable
-@env{SSH_AUTH_SOCK}. But this variable is not set when Emacs is
-started from a Desktop shortcut and authentication fails.
-
-One workaround is to use an MS Windows based SSH Agent, such as
-Pageant. It is part of the Putty Suite of tools.
-
-The fallback is to start Emacs from a shell.
-
-
@node Usage
@chapter Using @value{tramp}
@cindex using @value{tramp}
@@ -3100,6 +3332,7 @@ is a feature of Emacs that may cause missed prompts when
using
@end ifset
* File name completion:: File name completion.
* Ad-hoc multi-hops:: Declaring multiple hops in the file name.
+* Home directories:: Expanding @file{~} to home directory.
* Remote processes:: Integration with other Emacs packages.
* Cleanup remote connections:: Cleanup remote connections.
* Renaming remote files:: Renaming remote files.
@@ -3115,6 +3348,7 @@ is a feature of Emacs that may cause missed prompts when
using
@file{@trampfn{method,host,/path/to/file}} opens file @var{/path/to/file}
on the remote host @var{host}, using the method @var{method}.
+@c We cannot use @trampfn{} in @item.
@table @file
@item @value{prefix}ssh@value{postfixhop}melancholia@value{postfix}.emacs
For the file @file{.emacs} located in the home directory, on the host
@@ -3146,12 +3380,9 @@ brackets @file{@value{ipv6prefix}} and
@file{@value{ipv6postfix}}.
@end ifset
By default, @value{tramp} will use the current local user name as the
-remote user name for log in to the remote host. Specifying a different
-name using the proper syntax will override this default behavior:
-
-@example
-@trampfn{method,user@@host,path/to/file}
-@end example
+remote user name for log in to the remote host. Specifying a
+different name using the proper syntax will override this default
+behavior: @file{@trampfn{method,user@@host,path/to/file}}.
@file{@trampfn{ssh,daniel@@melancholia,.emacs}} is for file
@file{.emacs} in @code{daniel}'s home directory on the host,
@@ -3301,9 +3532,14 @@ the @file{~/.authinfo.gpg} authentication file. The
user option
@code{tramp-completion-use-auth-sources} controls, whether such a
search is performed during completion.
+@vindex tramp-completion-use-cache
Remote hosts previously visited or hosts whose connections are kept
persistently (@pxref{Connection caching}) will be included in the
-completion lists.
+completion lists. If you want to suppress this completion because
+there are invalid entries in the persistency file, for example if the
+host configuration changes often, or if you plug your laptop to
+different networks frequently, you can set the user option
+@code{tramp-completion-use-cache} to nil.
After remote host name completion comes completion of file names on
the remote host. It works the same as with local host file completion
@@ -3347,8 +3583,9 @@ remote host name and file name. For example, hopping
over a single
proxy @samp{bird@@bastion} to a remote file on @samp{you@@remotehost}:
@example
-@c @kbd{C-x C-f
@trampfn{ssh@value{postfixhop}bird@@bastion|ssh,you,remotehost,/path} @key{RET}}
-@kbd{C-x C-f
@value{prefix}ssh@value{postfixhop}bird@@bastion|ssh@value{postfixhop}you@@remotehost@value{postfix}/path
@key{RET}}
+@c @kbd{C-x C-f
@trampfn{ssh@value{postfixhop}bird@@bastion|ssh,you@@remotehost,/path}
@key{RET}}
+@kbd{C-x C-f @value{prefix}ssh@value{postfixhop}bird@@bastion|@c
+ssh@value{postfixhop}you@@remotehost@value{postfix}/path @key{RET}}
@end example
Each involved method must be an inline method (@pxref{Inline methods}).
@@ -3376,12 +3613,72 @@ Ad-hoc proxies can take patterns @code{%h} or @code{%u}
like in
@code{tramp-default-proxies-alist}. The following file name expands
to user @samp{root} on host @samp{remotehost}, starting with an
@option{ssh} session on host @samp{remotehost}:
-@samp{@value{prefix}ssh@value{postfixhop}%h|su@value{postfixhop}remotehost@value{postfix}}.
+@samp{@trampfn{ssh@value{postfixhop}%h|su,remotehost,}}.
-On the other hand, if a trailing hop does not specify a host name,
-the host name of the previous hop is reused. Therefore, the following
+On the other hand, if a trailing hop does not specify a host name, the
+host name of the previous hop is reused. Therefore, the following
file name is equivalent to the previous example:
-@samp{@value{prefix}ssh@value{postfixhop}remotehost|su@value{postfixhop}@value{postfix}}.
+@samp{@trampfn{ssh@value{postfixhop}remotehost|su,,}}.
+
+
+@node Home directories
+@section Expanding @file{~} to home directory
+
+Home directories on remote hosts can be typed as tilde @file{~}. If
+possible, they are expanded to the remote user's home directory on the
+remote host. Example:
+
+@example
+@group
+@trampfn{ssh,user@@host,~}
+@result{} @trampfn{ssh,user@@host,/home/user}
+@end group
+@end example
+
+This works in general for @option{ssh}-like methods, and for
+@option{sudoedit}. These methods allow also the home directory
+expansion for another user, like
+
+@example
+@group
+@trampfn{sudoedit,,~otheruser}
+@result{} @trampfn{sudoedit,root@@localhost,/home/otheruser}
+@end group
+@end example
+
+For other methods, a home directory can be expanded only if supported.
+This happens for example for the @option{sftp} method. Methods, which
+require a share directory in the remote file name (@option{afp},
+@option{smb}), use the value of this share directory as home
+directory:
+
+@example
+@group
+@trampfn{smb,user@@host,~}
+@result{} @trampfn{smb,user@@host,/share}
+@end group
+@end example
+
+Since @value{tramp} cannot know in advance which share directory is
+intended to use, this expansion can be applied only when a share
+directory has been used already.
+
+The methods @option{adb}, @option{rclone} and @option{sshfs} do not
+support home directory expansion at all. However, @value{tramp} keeps
+the home directory in the cache. Therefore, those methods could be
+configured to expand a home directory via a connection property,
+@xref{Predefined connection information}. Example:
+
+@lisp
+@group
+(add-to-list 'tramp-connection-properties
+ (list (regexp-quote
"@trampfn{sshfs,user@@randomhost.your.domain,}")
+ "~user" "/home/user"))
+@end group
+@end lisp
+
+When your remote file name does not contain a @samp{user} part, the
+connection property @t{"~"} must be used instead.
@node Remote processes
@@ -3419,9 +3716,9 @@ returns the exit code for it. When the user option
indication that the process has been interrupted, and returns a
corresponding string.
-This remote process handling does not apply to @acronym{GVFS} (see
-@ref{GVFS-based methods}) because the remote file system is mounted on
-the local host and @value{tramp} accesses it by changing the
+This remote process handling does not apply to @acronym{GVFS}
+(@pxref{GVFS-based methods}) because the remote file system is mounted
+on the local host and @value{tramp} accesses it by changing the
@code{default-directory}.
@value{tramp} starts a remote process when a command is executed in a
@@ -3441,7 +3738,7 @@ might also add their name to this environment variable,
like
For @value{tramp} to find the command on the remote, it must be
accessible through the default search path as setup by @value{tramp}
upon first connection. Alternatively, use an absolute path or extend
-@code{tramp-remote-path} (see @ref{Remote programs}):
+@code{tramp-remote-path} (@pxref{Remote programs}):
@lisp
@group
@@ -3563,9 +3860,8 @@ ensures the correct name of the remote shell program.
When @code{explicit-shell-file-name} is equal to @code{nil}, calling
@code{shell} interactively will prompt for a shell name.
-Starting with @w{Emacs 26}, you could use connection-local variables
-for setting different values of @code{explicit-shell-file-name} for
-different remote hosts.
+You could use connection-local variables for setting different values
+of @code{explicit-shell-file-name} for different remote hosts.
@ifinfo
@xref{Connection Variables, , , emacs}.
@end ifinfo
@@ -3799,6 +4095,127 @@ using the @code{:connection-type} keyword. If this
keyword is not
used, the value of @code{process-connection-type} is applied instead.
+@subsection Process properties of asynchronous remote processes
+@cindex Asynchronous remote processes
+
+When available, @value{tramp} adds process properties to process
+objects of asynchronous properties. However, it is not guaranteed
+that all these properties are set.
+
+@itemize
+@item @code{remote-tty}
+
+This is the name of the terminal a @var{process} uses on the remote
+host, i.e., it reads and writes on.
+
+@item @code{remote-pid}
+
+The process id of the command executed on the remote host. This is
+used when sending signals remotely.
+
+@item @code{remote-command}
+
+The remote command which has been invoked via @code{make-process} or
+@code{start-file-process}, a list of strings (program and its
+arguments). This does not show the additional shell sugar
+@value{tramp} makes around the commands, in order to see this you must
+inspect @value{tramp} @ref{Traces and Profiles, traces}.
+@end itemize
+
+@findex list-system-processes
+@findex process-attributes
+The functions @code{list-system-processes} and
+@code{process-attributes} return information about system processes on
+the respective remote host. In order to retrieve this information,
+they use the command @command{ps}, driven by the following constants:
+
+@defvr Constant tramp-process-attributes-ps-args
+This is a list of arguments (strings) @command{ps} is called with.
+The default value is appropriate for GNU/Linux remote hosts.
+@end defvr
+
+@defvr Constant tramp-process-attributes-ps-format
+This is a list of cons cells @code{(@var{key} . @var{type})} for
+interpretation of the @command{ps} output. @var{key} is a key used in
+the @code{process-attributes} output plus the key @code{pid}, and
+@var{type} is the respective value returned by @command{ps}. It can
+be
+
+
+@multitable {@bullet{} @code{numberp}} {--- a string of @var{number} width,
could contain spaces}
+@item @bullet{} @code{numberp} @tab --- a number
+@item @bullet{} @code{stringp} @tab --- a string without spaces
+@item @bullet{} @var{number}
+@tab --- a string of @var{number} width, could contain spaces
+@item @bullet{} @code{nil} @tab --- a string until end of line
+@end multitable
+
+The default value is appropriate for GNU/Linux remote hosts.
+@end defvr
+
+If, for example, @code{tramp-process-attributes-ps-args} is declared
+as @code{("-eww" "-o" "pid,euid,euser,egid,egroup,comm:40,state")},
+the output of the respective @command{ps} command would look like
+
+@smallexample
+@group
+ PID EUID EUSER EGID EGROUP COMMAND
S
+ 1 0 root 0 root systemd
S
+ 1610 0 root 0 root NFSv4 callback
S
+ @dots{}
+@end group
+@end smallexample
+
+The corresponding @code{tramp-process-attributes-ps-format} has the value
+
+@smallexample
+@group
+@code{((pid . numberp) (euid . numberp) (user . stringp)
+ (egid . numberp) (group . stringp) (comm . 40) (state . stringp))}
+@end group
+@end smallexample
+
+@vindex tramp-adb-connection-local-default-ps-profile
+@vindex tramp-adb-connection-local-default-ps-variables
+@vindex tramp-connection-local-bsd-ps-profile
+@vindex tramp-connection-local-bsd-ps-variables
+@vindex tramp-connection-local-busybox-ps-profile
+@vindex tramp-connection-local-busybox-ps-variables
+@vindex tramp-connection-local-darwin-ps-profile
+@vindex tramp-connection-local-darwin-ps-variables
+The default values for @code{tramp-process-attributes-ps-args} and
+@code{tramp-process-attributes-ps-format} can be overwritten by
+connection-local variables.
+@ifinfo
+@xref{Connection Variables, , , emacs}.
+@end ifinfo
+This is already done by @value{tramp} for the @option{adb} method, see
+@code{tramp-adb-connection-local-default-ps-profile} and
+@code{tramp-adb-connection-local-default-ps-variables}.
+
+There are three further predefined sets of connection-local variables
+for remote BSD systems, for remote macOS systems, and for a remote
+@command{ps} command implemented with @command{busybox}. These are
+called @code{tramp-connection-local-*-ps-profile} and
+@code{tramp-connection-local-*-ps-variables}. Use them like
+
+@lisp
+@group
+(connection-local-set-profiles
+ '(:application tramp :machine "mybsdhost")
+ 'tramp-connection-local-bsd-ps-profile)
+@end group
+@end lisp
+
+@cindex proced
+@vindex proced-show-remote-processes
+If you want to see a listing of remote system processes when calling
+@code{proced}, set user option @code{proced-show-remote-processes} to
+non-@code{nil}, or invoke that command with a negative argument like
+@kbd{C-u - M-x proced @key{RET}} when your buffer has a remote
+@code{default-directory}.
+
+
@anchor{Improving performance of asynchronous remote processes}
@subsection Improving performance of asynchronous remote processes
@cindex Asynchronous remote processes
@@ -3808,7 +4225,7 @@ used, the value of @code{process-connection-type} is
applied instead.
@value{tramp}'s implementation of @code{make-process} and
@code{start-file-process} requires a serious overhead for
initialization, every process invocation. This is needed for handling
-interactive dialogues when connecting the remote host (like providing
+interactive dialogs when connecting the remote host (like providing
a password), and initial environment setup.
Sometimes, this is not needed. Instead of starting a remote shell and
@@ -3836,8 +4253,9 @@ Furthermore, this approach has the following limitations:
@itemize
@item
-It works only for connection methods defined in @file{tramp-sh.el} and
-@file{tramp-adb.el}.
+It works only for some connection methods defined in
+@file{tramp-adb.el}, @file{tramp-container.el}, @file{tramp-sh.el} and
+@file{tramp-sshfs.el}.
@item
It does not support interactive user authentication. With
@@ -3980,7 +4398,7 @@ specifies the target to be applied for renaming buffer
file names from
source via @code{tramp-rename-files}. @code{source} is a regular
expressions, which matches a remote file name. @code{target} must be
a directory name, which could be remote (including remote directories
-Tramp infers by default, such as @samp{@trampfn{method,user@@host,}}).
+@value{tramp} infers by default, such as @samp{@trampfn{method,user@@host,}}).
@code{target} can contain the patterns @code{%m}, @code{%u} or
@code{%h}, which are replaced by the method name, user name or host
@@ -4003,7 +4421,9 @@ would trigger renaming of buffer file names on
@samp{badhost} to
@samp{goodhost}, including changing the directory name.
@lisp
-("@trampfn{ssh,.+\\\\.company\\\\.org,}" .
"@value{prefix}ssh@value{postfixhop}multi.hop|ssh@value{postfixhop}%h@value{postfix}")
+("@trampfn{ssh,.+\\\\.company\\\\.org,}" @c
+. "@value{prefix}ssh@value{postfixhop}multi.hop|@c
+ssh@value{postfixhop}%h@value{postfix}")
@end lisp
routes all connections to a host in @samp{company.org} via
@@ -4093,6 +4513,11 @@ CPIO archives
@cindex @file{cpio} file archive suffix
@cindex file archive suffix @file{cpio}
+@item @samp{.crate} ---
+Cargo (Rust) packages
+@cindex @file{crate} file archive suffix
+@cindex file archive suffix @file{crate}
+
@item @samp{.deb} ---
Debian packages
@cindex @file{deb} file archive suffix
@@ -4103,6 +4528,11 @@ HP-UX SD depots
@cindex @file{depot} file archive suffix
@cindex file archive suffix @file{depot}
+@item @samp{.epub} ---
+Electronic publications
+@cindex @file{epub} file archive suffix
+@cindex file archive suffix @file{epub}
+
@item @samp{.exe} ---
Self extracting Microsoft Windows EXE files
@cindex @file{exe} file archive suffix
@@ -4260,7 +4690,8 @@ It is even possible to access file archives in file
archives, as
(progn
(url-handler-mode 1)
(find-file
-
"https://ftp.debian.org/debian/pool/main/c/coreutils/coreutils_8.28-1_amd64.deb/control.tar.gz/control";))
+ "https://ftp.debian.org/debian/pool/main/c/coreutils/\
+coreutils_8.28-1_amd64.deb/control.tar.gz/control"))
@end group
@end lisp
@@ -4393,8 +4824,8 @@ Where is the latest @value{tramp}?
@item
Which systems does it work on?
-The package works successfully on @w{Emacs 25}, @w{Emacs 26}, @w{Emacs
-27}, and @w{Emacs 28}.
+The package works successfully on @w{Emacs 26}, @w{Emacs 27}, @w{Emacs
+28}, and @w{Emacs 29}.
While Unix and Unix-like systems are the primary remote targets,
@value{tramp} has equal success connecting to other platforms, such as
@@ -4592,97 +5023,6 @@ In order to disable those optimizations, set user option
@code{tramp-local-host-regexp} to @code{nil}.
-@item
-@value{tramp} does not recognize if a @command{ssh} session hangs
-
-@vindex ServerAliveInterval@r{, ssh option}
-@command{ssh} sessions on the local host hang when the network is
-down. @value{tramp} cannot safely detect such hangs. The network
-configuration for @command{ssh} can be configured to kill such hangs
-with the following command in the @file{~/.ssh/config}:
-
-@example
-@group
-Host *
- ServerAliveInterval 5
-@end group
-@end example
-
-
-@item
-@value{tramp} does not use default @command{ssh} @option{ControlPath}
-
-@vindex ControlPath@r{, ssh option}
-@vindex ControlPersist@r{, ssh option}
-@value{tramp} overwrites @option{ControlPath} settings when initiating
-@command{ssh} sessions. @value{tramp} does this to fend off a stall
-if a master session opened outside the Emacs session is no longer
-open. That is why @value{tramp} prompts for the password again even
-if there is an @command{ssh} already open.
-
-@vindex tramp-ssh-controlmaster-options
-Some @command{ssh} versions support a @option{ControlPersist} option,
-which allows you to set the @option{ControlPath} provided the variable
-@code{tramp-ssh-controlmaster-options} is customized as follows:
-
-@lisp
-@group
-(customize-set-variable
- 'tramp-ssh-controlmaster-options
- (concat
- "-o ControlPath=/tmp/ssh-ControlPath-%%r@@%%h:%%p "
- "-o ControlMaster=auto -o ControlPersist=yes"))
-@end group
-@end lisp
-
-Note how @samp{%r}, @samp{%h} and @samp{%p} must be encoded as
-@samp{%%r}, @samp{%%h} and @samp{%%p}.
-
-@vindex tramp-use-ssh-controlmaster-options
-If the @file{~/.ssh/config} file is configured appropriately for the
-above behavior, then any changes to @command{ssh} can be suppressed
-with this @code{nil} setting:
-
-@lisp
-(customize-set-variable 'tramp-use-ssh-controlmaster-options nil)
-@end lisp
-
-@vindex ProxyCommand@r{, ssh option}
-@vindex ProxyJump@r{, ssh option}
-This should also be set to @code{nil} if you use the
-@option{ProxyCommand} or @option{ProxyJump} options in your
-@command{ssh} configuration.
-
-On MS Windows, @code{tramp-use-ssh-controlmaster-options} is set to
-@code{nil} by default, because the MS Windows and MSYS2
-implementations of @command{OpenSSH} do not support this option properly.
-
-
-@item
-On multi-hop connections, @value{tramp} does not use @command{ssh}
-@option{ControlMaster}
-
-In order to use the @option{ControlMaster} option, @value{tramp} must
-check whether the @command{ssh} client supports this option. This is
-only possible on the local host, for the first hop. @value{tramp}
-does not use this option on proxy hosts.
-
-If you want to use this option also for the other hops, you must
-configure @file{~/.ssh/config} on the proxy host:
-
-@example
-@group
-Host *
- ControlMaster auto
- ControlPath tramp.%C
- ControlPersist no
-@end group
-@end example
-
-Check the @samp{ssh_config(5)} man page whether these options are
-supported on your proxy host.
-
-
@item
Does @value{tramp} support @acronym{SSH} security keys?
@@ -4875,6 +5215,26 @@ be restored by moving them manually from
@file{$@{XDG_DATA_HOME@}/Trash/files/}, if needed.
+@item
+How to identify temporary files produced by @value{tramp}?
+
+@vindex tramp-temp-name-prefix
+Temporary files are kept in your @code{temporary-file-directory}
+directory, which is often @file{/tmp/}. By default, they have the
+file name prefix @t{"tramp."}. If you want to change this prefix, for
+example because you want to identify temporary files produced by
+@code{file-local-copy} in your package, you can bind the variable
+@code{tramp-temp-name-prefix} temporarily:
+
+@example
+@group
+(let ((tramp-temp-name-prefix "my-prefix."))
+ (file-local-copy "@trampfn{ssh,,.emacs}"))
+@result{} "/tmp/my-prefix.HDfgDZ"
+@end group
+@end example
+
+
@item
How to shorten long file names when typing in @value{tramp}?
@@ -5123,7 +5483,8 @@ Why saved multi-hop file names do not work in a new Emacs
session?
When saving ad-hoc multi-hop @value{tramp} file names (@pxref{Ad-hoc
multi-hops}) via bookmarks, recent files, filecache, bbdb, or another
package, use the full ad-hoc file name including all hops, like
-@file{@trampfn{ssh,bird@@bastion|ssh@value{postfixhop}news.my.domain,/opt/news/etc}}.
+@file{@trampfn{ssh,bird@@bastion|ssh@value{postfixhop}@c
+news.my.domain,/opt/news/etc}}.
Alternatively, when saving abbreviated multi-hop file names
@file{@trampfn{ssh,news@@news.my.domain,/opt/news/etc}}, the user
@@ -5275,6 +5636,28 @@ time being you can suppress this error by the following
code in your
@end lisp
+@item
+I get an error @samp{Remote file error: Not a valid Tramp file name
+function `tramp-FOO-file-name-p'}
+
+@value{tramp} has changed the signature of an internal function.
+External packages implementing an own @value{tramp} backend must
+follow this change. Please report this problem to the author of that
+package.
+
+For the running session, @value{tramp} disables the external package,
+and you can continue to work. If you don't want to see this error
+while activating @value{tramp}, you can suppress it by the same code
+as above in your @file{~/.emacs}:
+
+@lisp
+@group
+(setq debug-ignored-errors
+ (cons 'remote-file-error debug-ignored-errors))
+@end group
+@end lisp
+
+
@item
How to disable other packages from calling @value{tramp}?
@@ -5293,6 +5676,7 @@ Disable @value{tramp} file name completion:
(customize-set-variable 'ido-enable-tramp-completion nil)
@end lisp
+@c Obsolete since Emacs 29.1.
@item
@file{rlogin.el}
@@ -5351,10 +5735,19 @@ local host's root directory as @file{/ssh:example.com:}.
To unload @value{tramp}, type @kbd{M-x tramp-unload-tramp @key{RET}}.
Unloading @value{tramp} resets Ange FTP plugins also.
@end itemize
+
+
+@item
+What is the difference between Ange FTP and @value{tramp}?
+
+The difference is that Ange FTP uses @command{ftp} to transfer files
+between the local and the remote host, whereas @value{tramp} uses a
+combination of @command{ssh} and @command{scp} or other work-alike
+programs.
@end itemize
-@c For the developer
+@c For the developer.
@node Files directories and localnames
@chapter How file names, directories and localnames are mangled and managed
@@ -5410,7 +5803,7 @@ bind it to non-@code{nil} value.
Keeping a local cache of remote file attributes in sync with the
remote host is a time-consuming operation. Flushing and re-querying
these attributes can tax @value{tramp} to a grinding halt on busy
-remote servers.
+remote hosts.
To get around these types of slow-downs in @value{tramp}'s
responsiveness, set the @code{process-file-side-effects} to @code{nil}
@@ -5565,6 +5958,8 @@ function call traces are written to the buffer
@file{*trace-output*}.
@c
@c * Say something about the .login and .profile files of the remote
@c shells.
+@c
@c * Explain how tramp.el works in principle: open a shell on a remote
@c host and then send commands to it.
+@c
@c * Consistent small or capitalized words especially in menus.
diff --git a/texi/trampelpa.texi b/texi/trampelpa.texi
index a9768417da..a2eb2e236b 100644
--- a/texi/trampelpa.texi
+++ b/texi/trampelpa.texi
@@ -17,12 +17,12 @@
@ifplaintext
@ifclear elpainclude
-Tramp stands for ``Transparent Remote (file) Access, Multiple
+@value{tramp} stands for ``Transparent Remote (file) Access, Multiple
Protocol''. This package provides remote file editing, similar to
Ange-FTP.
The difference is that Ange-FTP uses FTP to transfer files between the
-local and the remote host, whereas Tramp uses a combination of
+local and the remote host, whereas @value{tramp} uses a combination of
@option{rsh} and @option{rcp} or other work-alike programs, such as
@option{ssh}/@option{scp}.
@@ -37,21 +37,21 @@ Most of the parts are optional, read the manual
@end ifclear
@end ifplaintext
-Tramp must be compiled for the Emacs version you are running. If you
-experience compatibility error messages for the Tramp package, or if
-you use another major Emacs version than the version Tramp has been
-installed with, you must recompile the package:
+@value{tramp} must be compiled for the Emacs version you are running.
+If you experience compatibility error messages for the @value{tramp}
+package, or if you use another major Emacs version than the version
+@value{tramp} has been installed with, you must recompile the package:
@itemize @bullet
@item
-Remove all byte-compiled Tramp files
+Remove all byte-compiled @value{tramp} files
@example
$ rm -f ~/.emacs.d/elpa/tramp-@value{trampver}/tramp*.elc
@end example
@item
-Start Emacs with Tramp's source files
+Start Emacs with @value{tramp}'s source files
@example
$ emacs -L ~/.emacs.d/elpa/tramp-@value{trampver} -l tramp
@@ -60,7 +60,8 @@ $ emacs -L ~/.emacs.d/elpa/tramp-@value{trampver} -l tramp
This should not give you the error.
@item
-Recompile the Tramp package @strong{with this running Emacs instance}
+Recompile the @value{tramp} package @strong{with this running Emacs
+instance}
@example
M-x tramp-recompile-elpa
diff --git a/texi/trampver.texi b/texi/trampver.texi
index 32419878be..4342b463e9 100644
--- a/texi/trampver.texi
+++ b/texi/trampver.texi
@@ -5,13 +5,12 @@
@c Copyright (C) 2003--2022 Free Software Foundation, Inc.
@c See file doclicense.texi for copying conditions.
-@c In the Tramp GIT, the version numbers are auto-frobbed from
-@c tramp.el, and the bug report address is auto-frobbed from
-@c configure.ac.
-@set trampver 2.5.4
+@c In the Tramp GIT, the version number and the bug report address
+@c are auto-frobbed from configure.ac.
+@set trampver 2.6.0
@set trampurl https://www.gnu.org/software/tramp/
@set tramp-bug-report-address tramp-devel@@gnu.org
-@set emacsver 25.1
+@set emacsver 26.1
@c Other flags from configuration.
@set instprefix /usr/local
@@ -19,7 +18,12 @@
@set infodir /usr/local/share/info
@c Formatting of the tramp program name consistent.
+@ifplaintext
+@set tramp Tramp
+@end ifplaintext
+@ifnotplaintext
@set tramp @sc{Tramp}
+@end ifnotplaintext
@c Some flags which define the remote file name syntax.
@ifclear unified
diff --git a/tramp-adb.el b/tramp-adb.el
index 53796503bc..90020fbb1b 100644
--- a/tramp-adb.el
+++ b/tramp-adb.el
@@ -55,7 +55,7 @@ It is used for TCP/IP devices."
(defconst tramp-adb-method "adb"
"When this method name is used, forward all calls to Android Debug Bridge.")
-(defcustom tramp-adb-prompt "^[^#$\n\r]*[#$][[:space:]]"
+(defcustom tramp-adb-prompt (rx bol (* (not (any "#$\n\r"))) (any "#$") blank)
"Regexp used as prompt in almquist shell."
:type 'regexp
:version "28.1"
@@ -63,31 +63,30 @@ It is used for TCP/IP devices."
(eval-and-compile
(defconst tramp-adb-ls-date-year-regexp
- "[[:digit:]]\\{4\\}-[[:digit:]]\\{2\\}-[[:digit:]]\\{2\\}"
+ (rx (= 4 digit) "-" (= 2 digit) "-" (= 2 digit))
"Regexp for date year format in ls output."))
(eval-and-compile
- (defconst tramp-adb-ls-date-time-regexp
- "[[:digit:]]\\{2\\}:[[:digit:]]\\{2\\}"
+ (defconst tramp-adb-ls-date-time-regexp (rx (= 2 digit) ":" (= 2 digit))
"Regexp for date time format in ls output."))
(defconst tramp-adb-ls-date-regexp
- (concat
- "[[:space:]]" tramp-adb-ls-date-year-regexp
- "[[:space:]]" tramp-adb-ls-date-time-regexp
- "[[:space:]]")
+ (tramp-compat-rx
+ blank (regexp tramp-adb-ls-date-year-regexp)
+ blank (regexp tramp-adb-ls-date-time-regexp)
+ blank)
"Regexp for date format in ls output.")
(defconst tramp-adb-ls-toolbox-regexp
- (concat
- "^[[:space:]]*\\([-.[:alpha:]]+\\)" ; \1 permissions
- "\\(?:[[:space:]]+[[:digit:]]+\\)?" ; links (Android 7/toybox)
- "[[:space:]]*\\([^[:space:]]+\\)" ; \2 username
- "[[:space:]]+\\([^[:space:]]+\\)" ; \3 group
- "[[:space:]]+\\([[:digit:]]+\\)" ; \4 size
- "[[:space:]]+\\(" tramp-adb-ls-date-year-regexp
- "[[:space:]]" tramp-adb-ls-date-time-regexp "\\)" ; \5 date
- "[[:space:]]\\(.*\\)$") ; \6 filename
+ (tramp-compat-rx
+ bol (* blank) (group (+ (any ".-" alpha))) ; \1 permissions
+ (? (+ blank) (+ digit)) ; links (Android 7/toybox)
+ (* blank) (group (+ (not blank))) ; \2 username
+ (+ blank) (group (+ (not blank))) ; \3 group
+ (+ blank) (group (+ digit)) ; \4 size
+ (+ blank) (group (regexp tramp-adb-ls-date-year-regexp)
+ blank (regexp tramp-adb-ls-date-time-regexp)) ; \5 date
+ blank (group (* nonl)) eol) ; \6 filename
"Regexp for ls output.")
;;;###tramp-autoload
@@ -107,7 +106,8 @@ It is used for TCP/IP devices."
;;;###tramp-autoload
(defconst tramp-adb-file-name-handler-alist
- '((access-file . tramp-handle-access-file)
+ '(;; `abbreviate-file-name' performed by default handler.
+ (access-file . tramp-handle-access-file)
(add-name-to-file . tramp-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
(copy-directory . tramp-handle-copy-directory)
@@ -129,7 +129,7 @@ It is used for TCP/IP devices."
(file-directory-p . tramp-handle-file-directory-p)
(file-equal-p . tramp-handle-file-equal-p)
(file-executable-p . tramp-adb-handle-file-executable-p)
- (file-exists-p . tramp-handle-file-exists-p)
+ (file-exists-p . tramp-adb-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-adb-handle-file-local-copy)
(file-locked-p . tramp-handle-file-locked-p)
@@ -158,6 +158,7 @@ It is used for TCP/IP devices."
;; `get-file-buffer' performed by default handler.
(insert-directory . tramp-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
+ (list-system-processes . tramp-handle-list-system-processes)
(load . tramp-handle-load)
(lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
@@ -167,6 +168,8 @@ It is used for TCP/IP devices."
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . tramp-adb-handle-make-process)
(make-symbolic-link . tramp-handle-make-symbolic-link)
+ (memory-info . tramp-handle-memory-info)
+ (process-attributes . tramp-handle-process-attributes)
(process-file . tramp-adb-handle-process-file)
(rename-file . tramp-adb-handle-rename-file)
(set-file-acl . ignore)
@@ -178,8 +181,10 @@ It is used for TCP/IP devices."
(start-file-process . tramp-handle-start-file-process)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
- (tramp-get-remote-gid . ignore)
- (tramp-get-remote-uid . ignore)
+ (tramp-get-home-directory . ignore)
+ (tramp-get-remote-gid . tramp-adb-handle-get-remote-gid)
+ (tramp-get-remote-groups . tramp-adb-handle-get-remote-groups)
+ (tramp-get-remote-uid . tramp-adb-handle-get-remote-uid)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
(unlock-file . tramp-handle-unlock-file)
@@ -191,11 +196,10 @@ It is used for TCP/IP devices."
;; It must be a `defsubst' in order to push the whole code into
;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
;;;###tramp-autoload
-(defsubst tramp-adb-file-name-p (filename)
- "Check if it's a FILENAME for ADB."
- (and (tramp-tramp-file-p filename)
- (string= (tramp-file-name-method (tramp-dissect-file-name filename))
- tramp-adb-method)))
+(defsubst tramp-adb-file-name-p (vec-or-filename)
+ "Check if it's a VEC-OR-FILENAME for ADB."
+ (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
+ (string= (tramp-file-name-method vec) tramp-adb-method)))
;;;###tramp-autoload
(defun tramp-adb-file-name-handler (operation &rest args)
@@ -217,7 +221,8 @@ arguments to pass to the OPERATION."
(delq nil
(mapcar
(lambda (line)
- (when (string-match "^\\(\\S-+\\)[[:space:]]+device$" line)
+ (when (string-match
+ (rx bol (group (+ (not blank))) (+ blank) "device" eol) line)
;; Replace ":" by "#".
`(nil ,(tramp-compat-string-replace
":" tramp-prefix-port-format (match-string 1 line)))))
@@ -234,10 +239,10 @@ arguments to pass to the OPERATION."
(goto-char (point-min))
(forward-line)
(when (looking-at
- (concat "[[:space:]]*[^[:space:]]+"
- "[[:space:]]+\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)"))
+ (rx (* blank) (+ (not blank))
+ (+ blank) (group (+ digit))
+ (+ blank) (group (+ digit))
+ (+ blank) (group (+ digit))))
;; The values are given as 1k numbers, so we must change
;; them to number of bytes.
(list (* 1024 (string-to-number (match-string 1)))
@@ -249,25 +254,23 @@ arguments to pass to the OPERATION."
(defun tramp-adb-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
- (unless id-format (setq id-format 'integer))
- (ignore-errors
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property
- v localname (format "file-attributes-%s" id-format)
- (and
- (tramp-adb-send-command-and-check
- v (format "%s -d -l %s | cat"
- (tramp-adb-get-ls-command v)
- (tramp-shell-quote-argument localname)))
- (with-current-buffer (tramp-get-buffer v)
- (tramp-adb-sh-fix-ls-output)
- (cdar (tramp-do-parse-file-attributes-with-ls v id-format))))))))
-
-(defun tramp-do-parse-file-attributes-with-ls (vec &optional id-format)
+ ;; The result is cached in `tramp-convert-file-attributes'.
+ (with-parsed-tramp-file-name filename nil
+ (tramp-convert-file-attributes v localname id-format
+ (and
+ (tramp-adb-send-command-and-check
+ v (format "%s -d -l %s | cat"
+ (tramp-adb-get-ls-command v)
+ (tramp-shell-quote-argument localname)))
+ (with-current-buffer (tramp-get-buffer v)
+ (tramp-adb-sh-fix-ls-output)
+ (cdar (tramp-do-parse-file-attributes-with-ls v)))))))
+
+(defun tramp-do-parse-file-attributes-with-ls (vec)
"Parse `file-attributes' for Tramp files using the ls(1) command."
(with-current-buffer (tramp-get-buffer vec)
(goto-char (point-min))
- (let ((file-properties nil))
+ (let (file-properties)
(while (re-search-forward tramp-adb-ls-toolbox-regexp nil t)
(let* ((mod-string (match-string 1))
(is-dir (eq ?d (aref mod-string 0)))
@@ -279,16 +282,16 @@ arguments to pass to the OPERATION."
(name (match-string 6))
(symlink-target
(and is-symlink
- (cadr (split-string name "\\( -> \\|\n\\)")))))
+ (cadr (split-string name (rx (| " -> " "\n")))))))
(push (list
(if is-symlink
- (car (split-string name "\\( -> \\|\n\\)"))
+ (car (split-string name (rx (| " -> " "\n"))))
name)
(or is-dir symlink-target)
1 ;link-count
;; no way to handle numeric ids in Androids ash
- (if (eq id-format 'integer) 0 uid)
- (if (eq id-format 'integer) 0 gid)
+ (cons uid tramp-unknown-id-integer)
+ (cons gid tramp-unknown-id-integer)
tramp-time-dont-know ; atime
;; `date-to-time' checks `iso8601-parse', which might fail.
(let (signal-hook-function)
@@ -305,59 +308,31 @@ arguments to pass to the OPERATION."
(defun tramp-adb-handle-directory-files-and-attributes
(directory &optional full match nosort id-format count)
"Like `directory-files-and-attributes' for Tramp files."
- (unless (file-exists-p directory)
- (tramp-compat-file-missing (tramp-dissect-file-name directory) directory))
- (when (file-directory-p directory)
- (with-parsed-tramp-file-name (expand-file-name directory) nil
- (copy-tree
- (with-tramp-file-property
- v localname (format "directory-files-and-attributes-%s-%s-%s-%s-%s"
- full match id-format nosort count)
- (with-current-buffer (tramp-get-buffer v)
- (when (tramp-adb-send-command-and-check
- v (format "%s -a -l %s | cat"
- (tramp-adb-get-ls-command v)
- (tramp-shell-quote-argument localname)))
- ;; We insert also filename/. and filename/.., because
- ;; "ls" doesn't on some file systems, like "sdcard".
- (unless (re-search-backward "\\.$" nil t)
- (narrow-to-region (point-max) (point-max))
- (tramp-adb-send-command
- v (format "%s -d -a -l %s %s | cat"
- (tramp-adb-get-ls-command v)
- (tramp-shell-quote-argument
- (tramp-compat-file-name-concat localname "."))
- (tramp-shell-quote-argument
- (tramp-compat-file-name-concat localname ".."))))
- (tramp-compat-replace-regexp-in-region
- (regexp-quote
- (tramp-compat-file-name-unquote
- (file-name-as-directory localname)))
- "" (point-min))
- (widen)))
- (tramp-adb-sh-fix-ls-output)
- (let ((result (tramp-do-parse-file-attributes-with-ls
- v (or id-format 'integer))))
- (when full
- (setq result
- (mapcar
- (lambda (x)
- (cons (expand-file-name (car x) directory) (cdr x)))
- result)))
- (unless nosort
- (setq result
- (sort result (lambda (x y) (string< (car x) (car y))))))
-
- (setq result (delq nil
- (mapcar
- (lambda (x) (if (or (not match)
- (string-match-p
- match (car x)))
- x))
- result)))
- (when (and (natnump count) (> count 0))
- (setq result (nbutlast result (- (length result) count))))
- result)))))))
+ (tramp-skeleton-directory-files-and-attributes
+ directory full match nosort id-format count
+ (with-current-buffer (tramp-get-buffer v)
+ (when (tramp-adb-send-command-and-check
+ v (format "%s -a -l %s | cat"
+ (tramp-adb-get-ls-command v)
+ (tramp-shell-quote-argument localname)))
+ ;; We insert also filename/. and filename/.., because "ls"
+ ;; doesn't on some file systems, like "sdcard".
+ (unless (re-search-backward (rx "." eol) nil t)
+ (narrow-to-region (point-max) (point-max))
+ (tramp-adb-send-command
+ v (format "%s -d -a -l %s %s | cat"
+ (tramp-adb-get-ls-command v)
+ (tramp-shell-quote-argument
+ (tramp-compat-file-name-concat localname "."))
+ (tramp-shell-quote-argument
+ (tramp-compat-file-name-concat localname ".."))))
+ (tramp-compat-replace-regexp-in-region
+ (tramp-compat-rx (literal (tramp-compat-file-name-unquote
+ (file-name-as-directory localname))))
+ "" (point-min))
+ (widen)))
+ (tramp-adb-sh-fix-ls-output)
+ (tramp-do-parse-file-attributes-with-ls v))))
(defun tramp-adb-get-ls-command (vec)
"Determine `ls' command and its arguments."
@@ -391,16 +366,14 @@ Emacs dired can't find files."
(goto-char (point-min))
(while
(search-forward-regexp
- (eval-when-compile
- (concat
- "[[:space:]]"
- "\\([[:space:]]" tramp-adb-ls-date-year-regexp "[[:space:]]\\)"))
+ (tramp-compat-rx
+ blank (group blank (regexp tramp-adb-ls-date-year-regexp) blank))
nil t)
(replace-match "0\\1" "\\1" nil)
;; Insert missing "/".
(when (looking-at-p
- (eval-when-compile
- (concat tramp-adb-ls-date-time-regexp "[[:space:]]+$")))
+ (tramp-compat-rx
+ (regexp tramp-adb-ls-date-time-regexp) (+ blank) eol))
(end-of-line)
(insert "/")))
;; Sort entries.
@@ -420,6 +393,8 @@ Emacs dired can't find files."
(defun tramp-adb-ls-output-time-less-p (a b)
"Sort \"ls\" output by time, descending."
(let (time-a time-b)
+ ;; Once we can assume Emacs 27 or later, the two calls
+ ;; (apply #'encode-time X) can be replaced by (encode-time X).
(string-match tramp-adb-ls-date-regexp a)
(setq time-a (apply #'encode-time (parse-time-string (match-string 0 a))))
(string-match tramp-adb-ls-date-regexp b)
@@ -496,50 +471,73 @@ Emacs dired can't find files."
(delq
nil
(mapcar
- (lambda (l) (and (not (string-match-p "^[[:space:]]*$" l)) l))
+ (lambda (l)
+ (and (not (string-match-p (rx bol (* blank) eol) l)) l))
(split-string (buffer-string) "\n")))))))))))
(defun tramp-adb-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (unless (file-exists-p (file-truename filename))
- (tramp-compat-file-missing v filename))
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (with-tramp-progress-reporter
- v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
- ;; "adb pull ..." does not always return an error code.
- (unless
- (and (tramp-adb-execute-adb-command
- v "pull" (tramp-compat-file-name-unquote localname) tmpfile)
- (file-exists-p tmpfile))
- (ignore-errors (delete-file tmpfile))
- (tramp-error
- v 'file-error "Cannot make local copy of file `%s'" filename))
- (set-file-modes tmpfile (logior (or (file-modes filename) 0) #o0400)))
- tmpfile)))
+ (tramp-skeleton-file-local-copy filename
+ (with-tramp-progress-reporter
+ v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
+ ;; "adb pull ..." does not always return an error code.
+ (unless
+ (and (tramp-adb-execute-adb-command
+ v "pull" (tramp-compat-file-name-unquote localname) tmpfile)
+ (file-exists-p tmpfile))
+ (ignore-errors (delete-file tmpfile))
+ (tramp-error
+ v 'file-error "Cannot make local copy of file `%s'" filename))
+ (set-file-modes tmpfile (logior (or (file-modes filename) 0) #o0400)))))
(defun tramp-adb-handle-file-executable-p (filename)
"Like `file-executable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-executable-p"
- (tramp-adb-send-command-and-check
- v (format "test -x %s" (tramp-shell-quote-argument localname))))))
+ ;; Examine `file-attributes' cache to see if request can be
+ ;; satisfied without remote operation.
+ (if (tramp-file-property-p v localname "file-attributes")
+ (or (tramp-check-cached-permissions v ?x)
+ (tramp-check-cached-permissions v ?s))
+ (tramp-adb-send-command-and-check
+ v (format "test -x %s" (tramp-shell-quote-argument localname)))))))
+
+(defun tramp-adb-handle-file-exists-p (filename)
+ "Like `file-exists-p' for Tramp files."
+ ;; `file-exists-p' is used as predicate in file name completion.
+ ;; We don't want to run it when `non-essential' is t, or there is
+ ;; no connection process yet.
+ (when (tramp-connectable-p filename)
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (with-tramp-file-property v localname "file-exists-p"
+ (if (tramp-file-property-p v localname "file-attributes")
+ (not (null (tramp-get-file-property v localname "file-attributes")))
+ (tramp-adb-send-command-and-check
+ v (format "test -e %s" (tramp-shell-quote-argument localname))))))))
(defun tramp-adb-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-readable-p"
- (or (tramp-handle-file-readable-p filename)
- (tramp-adb-send-command-and-check
- v (format "test -r %s" (tramp-shell-quote-argument localname)))))))
+ ;; Examine `file-attributes' cache to see if request can be
+ ;; satisfied without remote operation.
+ (if (tramp-file-property-p v localname "file-attributes")
+ (tramp-handle-file-readable-p filename)
+ (tramp-adb-send-command-and-check
+ v (format "test -r %s" (tramp-shell-quote-argument localname)))))))
(defun tramp-adb-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-writable-p"
(if (file-exists-p filename)
- (tramp-adb-send-command-and-check
- v (format "test -w %s" (tramp-shell-quote-argument localname)))
+ (if (tramp-file-property-p v localname "file-attributes")
+ ;; Examine `file-attributes' cache to see if request can
+ ;; be satisfied without remote operation.
+ (tramp-check-cached-permissions v ?w)
+ (tramp-adb-send-command-and-check
+ v (format "test -w %s" (tramp-shell-quote-argument localname))))
+ ;; If file doesn't exist, check if directory is writable.
(and
(file-directory-p (file-name-directory filename))
(file-writable-p (file-name-directory filename)))))))
@@ -547,82 +545,40 @@ Emacs dired can't find files."
(defun tramp-adb-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename)
- lockname (file-truename (or lockname filename)))
- (with-parsed-tramp-file-name filename nil
- (when (and mustbenew (file-exists-p filename)
- (or (eq mustbenew 'excl)
- (not
- (y-or-n-p
- (format "File %s exists; overwrite anyway?" filename)))))
- (tramp-error v 'file-already-exists filename))
-
- (let ((file-locked (eq (file-locked-p lockname) t))
- (curbuf (current-buffer))
- (tmpfile (tramp-compat-make-temp-file filename)))
-
- ;; Lock file.
- (when (and (not (auto-save-file-name-p (file-name-nondirectory
filename)))
- (file-remote-p lockname)
- (not file-locked))
- (setq file-locked t)
- ;; `lock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'lock-file lockname))
-
- (when (and append (file-exists-p filename))
- (copy-file filename tmpfile 'ok)
- (set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600)))
- (let (create-lockfiles)
- (write-region start end tmpfile append 'no-message))
- (with-tramp-progress-reporter
- v 3 (format-message
- "Moving tmp file `%s' to `%s'" tmpfile filename)
- (unwind-protect
- (unless (tramp-adb-execute-adb-command
- v "push" tmpfile (tramp-compat-file-name-unquote
localname))
- (tramp-error v 'file-error "Cannot write: `%s'" filename))
- (delete-file tmpfile)))
-
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v localname)
-
- (unless (equal curbuf (current-buffer))
- (tramp-error
- v 'file-error
- "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))
-
- ;; Set file modification time.
- (when (or (eq visit t) (stringp visit))
- (set-visited-file-modtime
- (or (tramp-compat-file-attribute-modification-time
- (file-attributes filename))
- (current-time))))
-
- ;; Unlock file.
- (when file-locked
- ;; `unlock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'unlock-file lockname))
-
- ;; The end.
- (when (and (null noninteractive)
- (or (eq visit t) (string-or-null-p visit)))
- (tramp-message v 0 "Wrote %s" filename))
- (run-hooks 'tramp-handle-write-region-hook))))
+ (tramp-skeleton-write-region start end filename append visit lockname
mustbenew
+ ;; If `start' is the empty string, it is likely that a temporary
+ ;; file is created. Do it directly.
+ (if (and (stringp start) (string-empty-p start))
+ (tramp-adb-send-command-and-check
+ v (format "echo -n \"\" >%s" (tramp-shell-quote-argument localname)))
+
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
+ (when (and append (file-exists-p filename))
+ (copy-file filename tmpfile 'ok)
+ (set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600)))
+ (let (create-lockfiles)
+ (write-region start end tmpfile append 'no-message))
+ (with-tramp-progress-reporter
+ v 3 (format-message
+ "Moving tmp file `%s' to `%s'" tmpfile filename)
+ (unwind-protect
+ (unless (tramp-adb-execute-adb-command
+ v "push" tmpfile
+ (tramp-compat-file-name-unquote localname))
+ (tramp-error v 'file-error "Cannot write: `%s'" filename))
+ (delete-file tmpfile)))))))
(defun tramp-adb-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- ;; ADB shell does not support "chmod -h".
- (unless (and (eq flag 'nofollow) (file-symlink-p filename))
- (tramp-flush-file-properties v localname)
+ ;; ADB shell does not support "chmod -h".
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(tramp-adb-send-command-and-check
v (format "chmod %o %s" mode (tramp-shell-quote-argument localname))))))
(defun tramp-adb-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(let ((time (if (or (null time)
(tramp-compat-time-equal-p time tramp-time-doesnt-exist)
(tramp-compat-time-equal-p time tramp-time-dont-know))
@@ -663,69 +619,67 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; let-bind `jka-compr-inhibit' to t.
(jka-compr-inhibit t))
(with-parsed-tramp-file-name (if t1 filename newname) nil
- (unless (file-exists-p filename)
- (tramp-compat-file-missing v filename))
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-error "File is a directory %s" newname))
-
- (with-tramp-progress-reporter
- v 0 (format "Copying %s to %s" filename newname)
- (if (and t1 t2 (tramp-equal-remote filename newname))
- (let ((l1 (tramp-file-local-name filename))
- (l2 (tramp-file-local-name newname)))
- ;; We must also flush the cache of the directory,
- ;; because `file-attributes' reads the values from
- ;; there.
- (tramp-flush-file-properties v l2)
- ;; Short track.
- (tramp-adb-barf-unless-okay
- v (format
- "cp -f %s %s"
- (tramp-shell-quote-argument l1)
- (tramp-shell-quote-argument l2))
- "Error copying %s to %s" filename newname))
-
- (if-let ((tmpfile (file-local-copy filename)))
- ;; Remote filename.
- (condition-case err
- (rename-file tmpfile newname ok-if-already-exists)
- ((error quit)
- (delete-file tmpfile)
- (signal (car err) (cdr err))))
-
- ;; Remote newname.
- (when (and (file-directory-p newname)
- (directory-name-p newname))
- (setq newname
- (expand-file-name
- (file-name-nondirectory filename) newname)))
-
- (with-parsed-tramp-file-name newname nil
- (when (and (not ok-if-already-exists)
- (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
-
- ;; We must also flush the cache of the directory,
- ;; because `file-attributes' reads the values from
- ;; there.
- (tramp-flush-file-properties v localname)
- (unless (tramp-adb-execute-adb-command
- v "push"
- (tramp-compat-file-name-unquote filename)
- (tramp-compat-file-name-unquote localname))
- (tramp-error
- v 'file-error
- "Cannot copy `%s' `%s'" filename newname))))))))
+ (tramp-barf-if-file-missing v filename
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-error "File is a directory %s" newname))
+
+ (with-tramp-progress-reporter
+ v 0 (format "Copying %s to %s" filename newname)
+ (if (and t1 t2 (tramp-equal-remote filename newname))
+ (let ((l1 (tramp-file-local-name filename))
+ (l2 (tramp-file-local-name newname)))
+ ;; We must also flush the cache of the directory,
+ ;; because `file-attributes' reads the values from
+ ;; there.
+ (tramp-flush-file-properties v l2)
+ ;; Short track.
+ (tramp-adb-barf-unless-okay
+ v (format
+ "cp -f %s %s"
+ (tramp-shell-quote-argument l1)
+ (tramp-shell-quote-argument l2))
+ "Error copying %s to %s" filename newname))
+
+ (if-let ((tmpfile (file-local-copy filename)))
+ ;; Remote filename.
+ (condition-case err
+ (rename-file tmpfile newname ok-if-already-exists)
+ ((error quit)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err))))
+
+ ;; Remote newname.
+ (when (and (file-directory-p newname)
+ (directory-name-p newname))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory filename) newname)))
+
+ (with-parsed-tramp-file-name newname nil
+ (when (and (not ok-if-already-exists)
+ (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+
+ ;; We must also flush the cache of the directory,
+ ;; because `file-attributes' reads the values from
+ ;; there.
+ (tramp-flush-file-properties v localname)
+ (unless (tramp-adb-execute-adb-command
+ v "push"
+ (tramp-compat-file-name-unquote filename)
+ (tramp-compat-file-name-unquote localname))
+ (tramp-error
+ v 'file-error
+ "Cannot copy `%s' `%s'" filename newname)))))))))
;; KEEP-DATE handling.
(when keep-date
(tramp-compat-set-file-times
newname
- (tramp-compat-file-attribute-modification-time
- (file-attributes filename))
+ (file-attribute-modification-time (file-attributes filename))
(unless ok-if-already-exists 'nofollow)))))
(defun tramp-adb-handle-rename-file
@@ -745,42 +699,43 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; let-bind `jka-compr-inhibit' to t.
(jka-compr-inhibit t))
(with-parsed-tramp-file-name (if t1 filename newname) nil
- (unless (file-exists-p filename)
- (tramp-compat-file-missing v filename))
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-error "File is a directory %s" newname))
-
- (with-tramp-progress-reporter
- v 0 (format "Renaming %s to %s" filename newname)
- (if (and t1 t2
- (tramp-equal-remote filename newname)
- (not (file-directory-p filename)))
- (let ((l1 (tramp-file-local-name filename))
- (l2 (tramp-file-local-name newname)))
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v l1)
- (tramp-flush-file-properties v l2)
- ;; Short track.
- (tramp-adb-barf-unless-okay
- v (format
- "mv -f %s %s"
- (tramp-shell-quote-argument l1)
- (tramp-shell-quote-argument l2))
- "Error renaming %s to %s" filename newname))
-
- ;; Rename by copy.
- (copy-file
- filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid)
- (delete-file filename)))))))
+ (tramp-barf-if-file-missing v filename
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-error "File is a directory %s" newname))
+
+ (with-tramp-progress-reporter
+ v 0 (format "Renaming %s to %s" filename newname)
+ (if (and t1 t2
+ (tramp-equal-remote filename newname)
+ (not (file-directory-p filename)))
+ (let ((l1 (tramp-file-local-name filename))
+ (l2 (tramp-file-local-name newname)))
+ ;; We must also flush the cache of the directory,
+ ;; because `file-attributes' reads the values from
+ ;; there.
+ (tramp-flush-file-properties v l1)
+ (tramp-flush-file-properties v l2)
+ ;; Short track.
+ (tramp-adb-barf-unless-okay
+ v (format
+ "mv -f %s %s"
+ (tramp-shell-quote-argument l1)
+ (tramp-shell-quote-argument l2))
+ "Error renaming %s to %s" filename newname))
+
+ ;; Rename by copy.
+ (copy-file
+ filename newname ok-if-already-exists
+ 'keep-time 'preserve-uid-gid)
+ (delete-file filename))))))))
(defun tramp-adb-get-signal-strings (vec)
"Strings to return by `process-file' in case of signals."
(with-tramp-connection-property vec "signal-strings"
- (let ((default-directory (tramp-make-tramp-file-name vec 'localname))
+ (let ((default-directory (tramp-make-tramp-file-name vec 'noloc))
;; `shell-file-name' and `shell-command-switch' are needed
;; for Emacs < 27.1, which doesn't support connection-local
;; variables in `shell-command'.
@@ -794,10 +749,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(setcar result 0)
(dolist (line signals)
(when (string-match
- (concat
- "^[[:space:]]*\\([[:digit:]]+\\)"
- "[[:space:]]+\\S-+[[:space:]]+"
- "\\([[:alpha:]].*\\)$")
+ (rx bol (* blank) (group (+ digit))
+ (+ blank) (+ (not blank))
+ (+ blank) (group alpha (* nonl)) eol)
line)
(setcar
(nthcdr (string-to-number (match-string 1 line)) result)
@@ -906,7 +860,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; because the remote process could have changed them.
(when tmpinput (delete-file tmpinput))
(when process-file-side-effects
- (tramp-flush-directory-properties v ""))
+ (tramp-flush-directory-properties v "/"))
;; Return exit status.
(if (equal ret -1)
@@ -951,7 +905,10 @@ implementation will be used."
(signal 'wrong-type-argument (list #'symbolp coding)))
(when (eq connection-type t)
(setq connection-type 'pty))
- (unless (memq connection-type '(nil pipe pty))
+ (unless (or (and (consp connection-type)
+ (memq (car connection-type) '(nil pipe pty))
+ (memq (cdr connection-type) '(nil pipe pty)))
+ (memq connection-type '(nil pipe pty)))
(signal 'wrong-type-argument (list #'symbolp connection-type)))
(unless (or (null filter) (eq filter t) (functionp filter))
(signal 'wrong-type-argument (list #'functionp filter)))
@@ -976,6 +933,7 @@ implementation will be used."
(tramp-make-tramp-temp-file v))))
(remote-tmpstderr
(and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
+ (orig-command command)
(program (car command))
(args (cdr command))
(command
@@ -988,9 +946,10 @@ implementation will be used."
(or (null program) tramp-process-connection-type))
(bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
(name1 name)
- (i 0))
+ (i 0)
+ p)
- (when (string-match-p "[[:multibyte:]]" command)
+ (when (string-match-p (tramp-compat-rx multibyte) command)
(tramp-error
v 'file-error "Cannot apply multi-byte command `%s'" command))
@@ -999,95 +958,100 @@ implementation will be used."
(setq i (1+ i)
name1 (format "%s<%d>" name i)))
(setq name name1)
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name)
- (tramp-set-connection-property v "process-buffer" buffer)
-
- (with-current-buffer (tramp-get-connection-buffer v)
- (unwind-protect
- ;; We catch this event. Otherwise, `make-process'
- ;; could be called on the local host.
- (save-excursion
- (save-restriction
- ;; Activate narrowing in order to save BUFFER
- ;; contents. Clear also the modification time;
- ;; otherwise we might be interrupted by
- ;; `verify-visited-file-modtime'.
- (let ((buffer-undo-list t)
- (inhibit-read-only t)
- (coding-system-for-write
- (if (symbolp coding) coding (car coding)))
- (coding-system-for-read
- (if (symbolp coding) coding (cdr coding))))
- (clear-visited-file-modtime)
- (narrow-to-region (point-max) (point-max))
- ;; We call `tramp-adb-maybe-open-connection',
- ;; in order to cleanup the prompt afterwards.
- (tramp-adb-maybe-open-connection v)
- (delete-region (point-min) (point-max))
- ;; Send the command.
- (let* ((p (tramp-get-connection-process v)))
+
+ (with-tramp-saved-connection-properties
+ v '("process-name" "process-buffer")
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name)
+ (tramp-set-connection-property v "process-buffer" buffer)
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (unwind-protect
+ ;; We catch this event. Otherwise, `make-process'
+ ;; could be called on the local host.
+ (save-excursion
+ (save-restriction
+ ;; Activate narrowing in order to save BUFFER
+ ;; contents. Clear also the modification
+ ;; time; otherwise we might be interrupted by
+ ;; `verify-visited-file-modtime'.
+ (let ((buffer-undo-list t)
+ (inhibit-read-only t)
+ (coding-system-for-write
+ (if (symbolp coding) coding (car coding)))
+ (coding-system-for-read
+ (if (symbolp coding) coding (cdr coding))))
+ (clear-visited-file-modtime)
+ (narrow-to-region (point-max) (point-max))
+ ;; We call `tramp-adb-maybe-open-connection',
+ ;; in order to cleanup the prompt afterwards.
+ (tramp-adb-maybe-open-connection v)
+ (delete-region (point-min) (point-max))
+ ;; Send the command.
+ (setq p (tramp-get-connection-process v))
(tramp-adb-send-command v command nil t) ; nooutput
;; Set sentinel and filter.
(when sentinel
(set-process-sentinel p sentinel))
(when filter
(set-process-filter p filter))
+ (process-put p 'remote-command orig-command)
+ (tramp-set-connection-property
+ p "remote-command" orig-command)
;; Set query flag and process marker for
;; this process. We ignore errors, because
;; the process could have finished already.
(ignore-errors
(set-process-query-on-exit-flag p (null noquery))
- (set-marker (process-mark p) (point)))
- ;; We must flush them here already;
- ;; otherwise `rename-file', `delete-file' or
- ;; `insert-file-contents' will fail.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")
- ;; Copy tmpstderr file.
- (when (and (stringp stderr)
- (not (tramp-tramp-file-p stderr)))
- (add-function
- :after (process-sentinel p)
- (lambda (_proc _msg)
- (rename-file remote-tmpstderr stderr))))
- ;; Read initial output. Remove the first
- ;; line, which is the command echo.
- (unless (eq filter t)
- (while
- (progn
- (goto-char (point-min))
- (not (re-search-forward "[\n]" nil t)))
- (tramp-accept-process-output p 0))
- (delete-region (point-min) (point)))
- ;; Provide error buffer. This shows only
- ;; initial error messages; messages arriving
- ;; later on will be inserted when the
- ;; process is deleted. The temporary file
- ;; will exist until the process is deleted.
- (when (bufferp stderr)
- (with-current-buffer stderr
- (insert-file-contents-literally
- remote-tmpstderr 'visit))
- ;; Delete tmpstderr file.
- (add-function
- :after (process-sentinel p)
- (lambda (_proc _msg)
- (with-current-buffer stderr
- (insert-file-contents-literally
- remote-tmpstderr 'visit nil nil 'replace))
- (delete-file remote-tmpstderr))))
- ;; Return process.
- p))))
-
- ;; Save exit.
- (if (string-prefix-p tramp-temp-buffer-name (buffer-name))
- (ignore-errors
- (set-process-buffer (tramp-get-connection-process v) nil)
- (kill-buffer (current-buffer)))
- (set-buffer-modified-p bmp))
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")))))))))
+ (set-marker (process-mark p) (point))
+ ;; We must flush them here already;
+ ;; otherwise `rename-file', `delete-file'
+ ;; or `insert-file-contents' will fail.
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property
+ v "process-buffer")
+ ;; Copy tmpstderr file.
+ (when (and (stringp stderr)
+ (not (tramp-tramp-file-p stderr)))
+ (add-function
+ :after (process-sentinel p)
+ (lambda (_proc _msg)
+ (rename-file remote-tmpstderr stderr))))
+ ;; Read initial output. Remove the first
+ ;; line, which is the command echo.
+ (unless (eq filter t)
+ (while
+ (progn
+ (goto-char (point-min))
+ (not (search-forward "\n" nil t)))
+ (tramp-accept-process-output p 0))
+ (delete-region (point-min) (point)))
+ ;; Provide error buffer. This shows only
+ ;; initial error messages; messages
+ ;; arriving later on will be inserted when
+ ;; the process is deleted. The temporary
+ ;; file will exist until the process is
+ ;; deleted.
+ (when (bufferp stderr)
+ (with-current-buffer stderr
+ (insert-file-contents-literally
+ remote-tmpstderr 'visit))
+ ;; Delete tmpstderr file.
+ (add-function
+ :after (process-sentinel p)
+ (lambda (_proc _msg)
+ (with-current-buffer stderr
+ (insert-file-contents-literally
+ remote-tmpstderr 'visit nil nil 'replace))
+ (delete-file remote-tmpstderr))))
+ ;; Return process.
+ p))))
+
+ ;; Save exit.
+ (if (string-prefix-p tramp-temp-buffer-name (buffer-name))
+ (ignore-errors
+ (set-process-buffer p nil)
+ (kill-buffer (current-buffer)))
+ (set-buffer-modified-p bmp)))))))))))
(defun tramp-adb-handle-exec-path ()
"Like `exec-path' for Tramp files."
@@ -1104,6 +1068,27 @@ implementation will be used."
;; The equivalent to `exec-directory'.
`(,(tramp-file-local-name (expand-file-name default-directory)))))
+(defun tramp-adb-handle-get-remote-uid (vec id-format)
+ "Like `tramp-get-remote-uid' for Tramp files.
+ ID-FORMAT valid values are `string' and `integer'."
+ (tramp-adb-send-command vec "id")
+ (tramp-read-id-output vec)
+ (tramp-get-connection-property vec (format "uid-%s" id-format)))
+
+(defun tramp-adb-handle-get-remote-gid (vec id-format)
+ "Like `tramp-get-remote-gid' for Tramp files.
+ID-FORMAT valid values are `string' and `integer'."
+ (tramp-adb-send-command vec "id")
+ (tramp-read-id-output vec)
+ (tramp-get-connection-property vec (format "gid-%s" id-format)))
+
+(defun tramp-adb-handle-get-remote-groups (vec id-format)
+ "Like `tramp-get-remote-groups' for Tramp files.
+ID-FORMAT valid values are `string' and `integer'."
+ (tramp-adb-send-command vec "id")
+ (tramp-read-id-output vec)
+ (tramp-get-connection-property vec (format "groups-%s" id-format)))
+
(defun tramp-adb-get-device (vec)
"Return full host name from VEC to be used in shell execution.
E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\"
@@ -1156,7 +1141,7 @@ error and non-nil on success."
(defun tramp-adb-send-command (vec command &optional neveropen nooutput)
"Send the COMMAND to connection VEC."
- (if (string-match-p "[[:multibyte:]]" command)
+ (if (string-match-p (tramp-compat-rx multibyte) command)
;; Multibyte codepoints with four bytes are not supported at
;; least by toybox.
@@ -1180,12 +1165,12 @@ error and non-nil on success."
;; We can't use stty to disable echo of command. stty is said
;; to be added to toybox 0.7.6. busybox shall have it, but this
;; isn't used any longer for Android.
- (delete-matching-lines (regexp-quote command))
+ (delete-matching-lines (tramp-compat-rx bol (literal command) eol))
;; When the local machine is W32, there are still trailing ^M.
;; There must be a better solution by setting the correct coding
;; system, but this requires changes in core Tramp.
(goto-char (point-min))
- (while (re-search-forward "\r+$" nil t)
+ (while (re-search-forward (rx (+ "\r") eol) nil t)
(replace-match "" nil nil)))))))
(defun tramp-adb-send-command-and-check (vec command &optional exit-status)
@@ -1201,7 +1186,7 @@ the exit status."
(format "%s; echo tramp_exit_status $?" command)
"echo tramp_exit_status $?"))
(with-current-buffer (tramp-get-connection-buffer vec)
- (unless (tramp-search-regexp "tramp_exit_status [[:digit:]]+")
+ (unless (tramp-search-regexp (rx "tramp_exit_status " (+ digit)))
(tramp-error
vec 'file-error "Couldn't find exit status of `%s'" command))
(skip-chars-forward "^ ")
@@ -1229,12 +1214,12 @@ FMT and ARGS are passed to `error'."
(let ((inhibit-read-only t))
(goto-char (point-min))
;; ADB terminal sends "^H" sequences.
- (when (re-search-forward "<\b+" (point-at-eol) t)
+ (when (re-search-forward (rx "<" (+ "\b")) (line-end-position) t)
(forward-line 1)
(delete-region (point-min) (point)))
;; Delete the prompt.
(goto-char (point-min))
- (when (re-search-forward prompt (point-at-eol) t)
+ (when (re-search-forward prompt (line-end-position) t)
(forward-line 1)
(delete-region (point-min) (point)))
(when (tramp-search-regexp prompt)
@@ -1263,7 +1248,7 @@ connection if a previous connection has died for some
reason."
;; Maybe we know already that "su" is not supported. We cannot
;; use a connection property, because we have not checked yet
;; whether it is still the same device.
- (when (and user (not (tramp-get-file-property vec "" "su-command-p" t)))
+ (when (and user (not (tramp-get-file-property vec "/" "su-command-p" t)))
(tramp-error vec 'file-error "Cannot switch to user `%s'" user))
(unless (process-live-p p)
@@ -1303,7 +1288,7 @@ connection if a previous connection has died for some
reason."
;; Change prompt.
(tramp-set-connection-property
- p "prompt" (regexp-quote (format "///%s#$" prompt)))
+ p "prompt" (tramp-compat-rx "///" (literal prompt) "#$"))
(tramp-adb-send-command
vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt))
@@ -1325,8 +1310,7 @@ connection if a previous connection has died for some
reason."
"echo \\\"`getprop ro.product.model` "
"`getprop ro.product.version` "
"`getprop ro.build.version.release`\\\""))
- (let ((old-getprop
- (tramp-get-connection-property vec "getprop" nil))
+ (let ((old-getprop (tramp-get-connection-property vec "getprop"))
(new-getprop
(tramp-set-connection-property
vec "getprop"
@@ -1349,31 +1333,46 @@ connection if a previous connection has died for some
reason."
(unless (tramp-adb-send-command-and-check vec nil)
(delete-process p)
;; Do not flush, we need the nil value.
- (tramp-set-file-property vec "" "su-command-p" nil)
+ (tramp-set-file-property vec "/" "su-command-p" nil)
(tramp-error
vec 'file-error "Cannot switch to user `%s'" user)))
;; Mark it as connected.
(tramp-set-connection-property p "connected" t)))))))
-;;; Default connection-local variables for Tramp:
-;; `connection-local-set-profile-variables' and
-;; `connection-local-set-profiles' exists since Emacs 26.1.
+;;; Default connection-local variables for Tramp.
(defconst tramp-adb-connection-local-default-shell-variables
'((shell-file-name . "/system/bin/sh")
(shell-command-switch . "-c"))
"Default connection-local shell variables for remote adb connections.")
-(tramp-compat-funcall
- 'connection-local-set-profile-variables
+(connection-local-set-profile-variables
'tramp-adb-connection-local-default-shell-profile
tramp-adb-connection-local-default-shell-variables)
+(defconst tramp-adb-connection-local-default-ps-variables
+ '((tramp-process-attributes-ps-args)
+ (tramp-process-attributes-ps-format
+ . ((user . string)
+ (pid . number)
+ (ppid . number)
+ (vsize . number)
+ (rss . number)
+ (wchan . string) ; ??
+ (pc . string) ; ??
+ (state . string)
+ (args . nil))))
+ "Default connection-local ps variables for remote adb connections.")
+
+(connection-local-set-profile-variables
+ 'tramp-adb-connection-local-default-ps-profile
+ tramp-adb-connection-local-default-ps-variables)
+
(with-eval-after-load 'shell
- (tramp-compat-funcall
- 'connection-local-set-profiles
+ (connection-local-set-profiles
`(:application tramp :protocol ,tramp-adb-method)
- 'tramp-adb-connection-local-default-shell-profile))
+ 'tramp-adb-connection-local-default-shell-profile
+ 'tramp-adb-connection-local-default-ps-profile))
;; `shell-mode' tries to open remote files like "/adb::~/.history".
;; This fails, because the tilde cannot be expanded. Tell
@@ -1387,7 +1386,7 @@ connection if a previous connection has died for some
reason."
(funcall orig-fun)))
(add-function
- :around (symbol-function #'shell-mode) #'tramp-adb-tolerate-tilde)
+ :around (symbol-function #'shell-mode) #'tramp-adb-tolerate-tilde)
(add-hook 'tramp-adb-unload-hook
(lambda ()
(remove-function
diff --git a/tramp-archive.el b/tramp-archive.el
index 33348ca21e..49b0c0bb6b 100644
--- a/tramp-archive.el
+++ b/tramp-archive.el
@@ -54,8 +54,10 @@
;; * ".ar" - UNIX archiver formats
;; * ".cab", ".CAB" - Microsoft Windows cabinets
;; * ".cpio" - CPIO archives
+;; * ".crate" - Cargo (Rust) packages
;; * ".deb" - Debian packages
;; * ".depot" - HP-UX SD depots
+;; * ".epub" - Electronic publications
;; * ".exe" - Self extracting Microsoft Windows EXE files
;; * ".iso" - ISO 9660 images
;; * ".jar" - Java archives
@@ -110,8 +112,10 @@
(eval-when-compile (require 'cl-lib))
;; Sometimes, compilation fails with "Variable binding depth exceeds
;; max-specpdl-size". Shall be fixed in Emacs 27.
-(eval-and-compile
- (let ((max-specpdl-size (* 2 max-specpdl-size))) (require 'tramp-gvfs)))
+(with-no-warnings ;; max-specpdl-size
+ (eval-and-compile
+ (let ((max-specpdl-size (* 2 max-specpdl-size)))
+ (require 'tramp-gvfs))))
(autoload 'dired-uncache "dired")
(autoload 'url-tramp-convert-url-to-tramp "url-tramp")
@@ -141,8 +145,10 @@
"ar" ;; UNIX archiver formats.
"cab" "CAB" ;; Microsoft Windows cabinets.
"cpio" ;; CPIO archives.
+ "crate" ;; Cargo (Rust) packages. Not in libarchive testsuite.
"deb" ;; Debian packages. Not in libarchive testsuite.
"depot" ;; HP-UX SD depot. Not in libarchive testsuite.
+ "epub" ;; Electronic publications. Not in libarchive testsuite.
"exe" ;; Self extracting Microsoft Windows EXE files.
"iso" ;; ISO 9660 images.
"jar" ;; Java archives. Not in libarchive testsuite.
@@ -164,7 +170,8 @@
It must be supported by libarchive(3).")
;; <https://unix-memo.readthedocs.io/en/latest/vfs.html>
-;; read and write: tar, cpio, pax , gzip , zip, bzip2, xz, lzip, lzma, ar,
mtree, iso9660, compress.
+;; read and write: tar, cpio, pax , gzip , zip, bzip2, xz, lzip,
+;; lzma, ar, mtree, iso9660, compress.
;; read only: 7-Zip, mtree, xar, lha/lzh, rar, microsoft cab.
;;;###autoload
@@ -176,9 +183,12 @@ It must be supported by libarchive(3).")
;; The definition of `tramp-archive-file-name-regexp' contains calls
;; to `regexp-opt', which cannot be autoloaded while loading
;; loaddefs.el. So we use a macro, which is evaluated only when needed.
+;; Emacs 26 and earlier cannot use the autoload form
+;; `tramp-compat-rx'. So we refrain from using `rx'.
;;;###autoload
(progn (defmacro tramp-archive-autoload-file-name-regexp ()
"Regular expression matching archive file names."
+ (if (<= emacs-major-version 26)
'(concat
"\\`" "\\(" ".+" "\\."
;; Default suffixes ...
@@ -186,18 +196,37 @@ It must be supported by libarchive(3).")
;; ... with compression.
"\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*"
"\\)" ;; \1
- "\\(" "/" ".*" "\\)" "\\'"))) ;; \2
+ "\\(" "/" ".*" "\\)" "\\'") ;; \2
+ `(rx
+ bos
+ ;; This group is used in `tramp-archive-file-name-archive'.
+ (group
+ (+ nonl)
+ ;; Default suffixes ...
+ "." (| ,@tramp-archive-suffixes)
+ ;; ... with compression.
+ (? "." (| ,@tramp-archive-compression-suffixes)))
+ ;; This group is used in `tramp-archive-file-name-localname'.
+ (group "/" (* nonl))
+ eos))))
(put #'tramp-archive-autoload-file-name-regexp 'tramp-autoload t)
-;; In older Emacsen (prior 27.1), `tramp-archive-autoload-file-name-regexp'
+;; In older Emacs (prior 27.1), `tramp-archive-autoload-file-name-regexp'
;; is not autoloaded. So we cannot expect it to be known in
;; tramp-loaddefs.el. But it exists, when tramp-archive.el is loaded.
+;; We must wrap it into `eval-when-compile'. Otherwise, there could
+;; be an "Eager macro-expansion failure" when unloading/reloading Tramp.
;;;###tramp-autoload
(defconst tramp-archive-file-name-regexp
- (ignore-errors (tramp-archive-autoload-file-name-regexp))
+ (eval-when-compile (ignore-errors (tramp-archive-autoload-file-name-regexp)))
"Regular expression matching archive file names.")
+;; The value above is nil for Emacs 26. Set it now.
+(if (<= emacs-major-version 26)
+ (setq tramp-archive-file-name-regexp
+ (ignore-errors (tramp-archive-autoload-file-name-regexp))))
+
;;;###tramp-autoload
(defconst tramp-archive-method "archive"
"Method name for archives in GVFS.")
@@ -213,7 +242,8 @@ It must be supported by libarchive(3).")
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-archive-file-name-handler-alist
- '((access-file . tramp-archive-handle-access-file)
+ '(;; `abbreviate-file-name' performed by default handler.
+ (access-file . tramp-archive-handle-access-file)
(add-name-to-file . tramp-archive-handle-not-implemented)
;; `byte-compiler-base-file-name' performed by default handler.
;; `copy-directory' performed by default handler.
@@ -222,7 +252,7 @@ It must be supported by libarchive(3).")
(delete-file . tramp-archive-handle-not-implemented)
;; `diff-latest-backup-file' performed by default handler.
(directory-file-name . tramp-archive-handle-directory-file-name)
- (directory-files . tramp-handle-directory-files)
+ (directory-files . tramp-archive-handle-directory-files)
(directory-files-and-attributes
. tramp-handle-directory-files-and-attributes)
(dired-compress-file . tramp-archive-handle-not-implemented)
@@ -235,7 +265,7 @@ It must be supported by libarchive(3).")
(file-directory-p . tramp-handle-file-directory-p)
(file-equal-p . tramp-handle-file-equal-p)
(file-executable-p . tramp-archive-handle-file-executable-p)
- (file-exists-p . tramp-handle-file-exists-p)
+ (file-exists-p . tramp-archive-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-archive-handle-file-local-copy)
(file-locked-p . ignore)
@@ -264,6 +294,7 @@ It must be supported by libarchive(3).")
;; `get-file-buffer' performed by default handler.
(insert-directory . tramp-archive-handle-insert-directory)
(insert-file-contents . tramp-archive-handle-insert-file-contents)
+ (list-system-processes . ignore)
(load . tramp-archive-handle-load)
(lock-file . ignore)
(make-auto-save-file-name . ignore)
@@ -273,6 +304,8 @@ It must be supported by libarchive(3).")
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
(make-symbolic-link . tramp-archive-handle-not-implemented)
+ (memory-info . ignore)
+ (process-attributes . ignore)
(process-file . ignore)
(rename-file . tramp-archive-handle-not-implemented)
(set-file-acl . ignore)
@@ -284,7 +317,9 @@ It must be supported by libarchive(3).")
(start-file-process . tramp-archive-handle-not-implemented)
;; `substitute-in-file-name' performed by default handler.
(temporary-file-directory . tramp-archive-handle-temporary-file-directory)
+ (tramp-get-home-directory . ignore)
(tramp-get-remote-gid . ignore)
+ (tramp-get-remote-groups . ignore)
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
@@ -301,7 +336,8 @@ Operations not mentioned here will be handled by the
default Emacs primitives.")
#'tramp-archive-file-name-p))
(apply #'tramp-file-name-for-operation operation args)))
-(defun tramp-archive-run-real-handler (operation args)
+;;;###tramp-autoload
+(progn (defun tramp-archive-run-real-handler (operation args)
"Invoke normal file name handler for OPERATION.
First arg specifies the OPERATION, second arg ARGS is a list of
arguments to pass to the OPERATION."
@@ -311,7 +347,7 @@ arguments to pass to the OPERATION."
,(and (eq inhibit-file-name-operation operation)
inhibit-file-name-handlers)))
(inhibit-file-name-operation operation))
- (apply operation args)))
+ (apply operation args))))
;;;###tramp-autoload
(defun tramp-archive-file-name-handler (operation &rest args)
@@ -324,6 +360,7 @@ arguments to pass to the OPERATION."
(tramp-register-file-name-handlers)
(tramp-archive-run-real-handler operation args))
+ (with-no-warnings ;; max-specpdl-size
(let* ((filename (apply #'tramp-archive-file-name-for-operation
operation args))
(archive (tramp-archive-file-name-archive filename))
@@ -357,7 +394,7 @@ arguments to pass to the OPERATION."
(setq args (cons operation args)))
(if fn
(save-match-data (apply (cdr fn) args))
- (tramp-archive-run-real-handler operation args)))))))
+ (tramp-archive-run-real-handler operation args))))))))
;;;###autoload
(progn (defun tramp-archive-autoload-file-name-handler (operation &rest args)
@@ -374,30 +411,30 @@ arguments to pass to the OPERATION."
(put #'tramp-archive-autoload-file-name-handler 'tramp-autoload t)
;;;###autoload
-(progn (defun tramp-register-archive-file-name-handler ()
+(progn (defun tramp-register-archive-autoload-file-name-handler ()
"Add archive file name handler to `file-name-handler-alist'."
(when (and tramp-archive-enabled
(not
- (rassq #'tramp-archive-file-name-handler
file-name-handler-alist)))
+ (rassq 'tramp-archive-file-name-handler
file-name-handler-alist)))
(add-to-list 'file-name-handler-alist
(cons (tramp-archive-autoload-file-name-regexp)
#'tramp-archive-autoload-file-name-handler))
(put #'tramp-archive-autoload-file-name-handler 'safe-magic t))))
-(put #'tramp-register-archive-file-name-handler 'tramp-autoload t)
+(put #'tramp-register-archive-autoload-file-name-handler 'tramp-autoload t)
;;;###autoload
(progn
- (add-hook 'after-init-hook #'tramp-register-archive-file-name-handler)
+ (add-hook 'after-init-hook
#'tramp-register-archive-autoload-file-name-handler)
(add-hook
'tramp-archive-unload-hook
(lambda ()
(remove-hook
- 'after-init-hook #'tramp-register-archive-file-name-handler))))
+ 'after-init-hook #'tramp-register-archive-autoload-file-name-handler))))
;; In older Emacsen (prior 27.1), the autoload above does not exist.
;; So we call it again; it doesn't hurt.
-(tramp-register-archive-file-name-handler)
+(tramp-register-archive-autoload-file-name-handler)
;; Mark `operations' the handler is responsible for.
(put #'tramp-archive-file-name-handler 'operations
@@ -468,7 +505,7 @@ name is kept in slot `hop'"
((tramp-archive-file-name-p archive)
(let ((archive
(tramp-make-tramp-file-name
- (tramp-archive-dissect-file-name archive) nil 'noarchive)))
+ (tramp-archive-dissect-file-name archive))))
(setf (tramp-file-name-host vec) (tramp-archive-gvfs-host archive)))
(puthash archive (list vec) tramp-archive-hash))
@@ -571,8 +608,7 @@ offered."
(defun tramp-archive-gvfs-file-name (name)
"Return NAME in GVFS syntax."
- (tramp-make-tramp-file-name
- (tramp-archive-dissect-file-name name) nil 'nohop))
+ (tramp-make-tramp-file-name (tramp-archive-dissect-file-name name)))
;; File name primitives.
@@ -586,9 +622,8 @@ offered."
preserve-uid-gid preserve-extended-attributes)
"Like `copy-file' for file archives."
(when (tramp-archive-file-name-p newname)
- (tramp-error
- (tramp-archive-dissect-file-name newname) 'file-error
- "Permission denied: %s" newname))
+ (tramp-compat-permission-denied
+ (tramp-archive-dissect-file-name newname) newname))
(copy-file
(tramp-archive-gvfs-file-name filename) newname ok-if-already-exists
keep-date preserve-uid-gid preserve-extended-attributes))
@@ -605,6 +640,27 @@ offered."
;; example. So we return `directory'.
directory)))
+(defun tramp-archive-handle-directory-files
+ (directory &optional full match nosort count)
+ "Like `directory-files' for Tramp files."
+ (unless (file-exists-p directory)
+ (tramp-error (tramp-dissect-file-name directory) 'file-missing directory))
+ (when (file-directory-p directory)
+ (setq directory (file-name-as-directory (expand-file-name directory)))
+ (let ((temp (nreverse (file-name-all-completions "" directory)))
+ result item)
+
+ (while temp
+ (setq item (directory-file-name (pop temp)))
+ (when (or (null match) (string-match-p match item))
+ (push (if full (concat directory item) item)
+ result)))
+ (unless nosort
+ (setq result (sort result #'string<)))
+ (when (and (natnump count) (> count 0))
+ (setq result (tramp-compat-ntake count result)))
+ result)))
+
(defun tramp-archive-handle-dired-uncache (dir)
"Like `dired-uncache' for file archives."
(dired-uncache (tramp-archive-gvfs-file-name dir)))
@@ -617,6 +673,10 @@ offered."
"Like `file-executable-p' for file archives."
(file-executable-p (tramp-archive-gvfs-file-name filename)))
+(defun tramp-archive-handle-file-exists-p (filename)
+ "Like `file-exists-p' for file archives."
+ (file-exists-p (tramp-archive-gvfs-file-name filename)))
+
(defun tramp-archive-handle-file-local-copy (filename)
"Like `file-local-copy' for file archives."
(file-local-copy (tramp-archive-gvfs-file-name filename)))
@@ -632,7 +692,7 @@ offered."
(defun tramp-archive-handle-file-system-info (filename)
"Like `file-system-info' for file archives."
(with-parsed-tramp-archive-file-name filename nil
- (list (tramp-compat-file-attribute-size (file-attributes archive)) 0 0)))
+ (list (file-attribute-size (file-attributes archive)) 0 0)))
(defun tramp-archive-handle-file-truename (filename)
"Like `file-truename' for file archives."
@@ -672,7 +732,7 @@ offered."
;; mounted directory, it is returned as it. Not what we want.
(with-parsed-tramp-archive-file-name default-directory nil
(let ((default-directory (file-name-directory archive)))
- (tramp-compat-temporary-file-directory-function))))
+ (temporary-file-directory))))
(defun tramp-archive-handle-not-implemented (operation &rest args)
"Generic handler for operations not implemented for file archives."
diff --git a/tramp-cache.el b/tramp-cache.el
index 347da916ed..912ea5f8bb 100644
--- a/tramp-cache.el
+++ b/tramp-cache.el
@@ -28,7 +28,7 @@
;; An implementation of information caching for remote files.
;; Each connection, identified by a `tramp-file-name' structure or by
-;; a process, has a unique cache. We distinguish 4 kind of caches,
+;; a process, has a unique cache. We distinguish 6 kind of caches,
;; depending on the key:
;;
;; - localname is nil. These are reusable properties. Examples:
@@ -37,10 +37,10 @@
;; host when starting a Perl script. These properties are saved in
;; the file `tramp-persistency-file-name'.
;;
-;; - localname is a string. These are temporary properties, which are
-;; related to the file localname is referring to. Examples:
-;; "file-exists-p" is t or nil, depending on the file existence, or
-;; "file-attributes" caches the result of the function
+;; - localname is an absolute file name. These are temporary
+;; properties, which are related to the file localname is referring
+;; to. Examples: "file-exists-p" is t or nil, depending on the file
+;; existence, or "file-attributes" caches the result of the function
;; `file-attributes'. These entries have a timestamp, and they
;; expire after `remote-file-name-inhibit-cache' seconds if this
;; variable is set.
@@ -48,7 +48,7 @@
;; - The key is a process. These are temporary properties related to
;; an open connection. Examples: "scripts" keeps shell script
;; definitions already sent to the remote shell, "last-cmd-time" is
-;; the time stamp a command has been sent to the remote process.
+;; the timestamp a command has been sent to the remote process.
;;
;; - The key is nil. These are temporary properties related to the
;; local machine. Examples: "parse-passwd" and "parse-group" keep
@@ -56,6 +56,10 @@
;; "{uid,gid}-{integer,string}" are the local uid and gid, and
;; "locale" is the used shell locale.
;;
+;; - The key is `tramp-cache-version'. It keeps the Tramp version the
+;; cache data was produced with. If the cache is read by another
+;; Tramp version, it is flushed.
+;;
;; - The key is `tramp-cache-undefined'. All functions return the
;; expected values, but nothing is cached.
@@ -75,8 +79,9 @@
;;; Code:
-(require 'tramp)
-(autoload 'time-stamp-string "time-stamp")
+(require 'tramp-compat)
+(require 'tramp-loaddefs)
+(require 'time-stamp)
;;; -- Cache --
@@ -99,12 +104,15 @@ details see the info pages."
(choice :tag " Value" sexp))))
;;;###tramp-autoload
-(defcustom tramp-persistency-file-name
- (expand-file-name (locate-user-emacs-file "tramp"))
+(defcustom tramp-persistency-file-name (locate-user-emacs-file "tramp")
"File which keeps connection history for Tramp connections."
:group 'tramp
:type 'file)
+;;;###tramp-autoload
+(defconst tramp-cache-version (make-tramp-file-name :method "cache")
+"Virtual connection vector for Tramp version.")
+
(defvar tramp-cache-data-changed nil
"Whether persistent cache data have been changed.")
@@ -125,52 +133,51 @@ If KEY is `tramp-cache-undefined', don't create anything,
and return nil."
(dolist (elt tramp-connection-properties)
(when (string-match-p
(or (nth 0 elt) "")
- (tramp-make-tramp-file-name key 'noloc 'nohop))
+ (tramp-make-tramp-file-name key 'noloc))
(tramp-set-connection-property key (nth 1 elt) (nth 2 elt)))))
hash))))
;;;###tramp-autoload
-(defun tramp-get-file-property (key file property default)
+(defun tramp-get-file-property (key file property &optional default)
"Get the PROPERTY of FILE from the cache context of KEY.
Return DEFAULT if not set."
;; Unify localname. Remove hop from `tramp-file-name' structure.
- (setq 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))
- (cached (and (hash-table-p hash) (gethash property hash)))
- (cached-at (and (consp cached) (format-time-string "%T" (car cached))))
- (value default)
- cache-used)
-
- (when ;; We take the value only if there is any, and
- ;; `remote-file-name-inhibit-cache' indicates that it is
- ;; still valid. Otherwise, DEFAULT is set.
- (and (consp cached)
- (or (null remote-file-name-inhibit-cache)
- (and (integerp remote-file-name-inhibit-cache)
- (time-less-p
- nil
- (time-add (car cached) remote-file-name-inhibit-cache)))
- (and (consp remote-file-name-inhibit-cache)
- (time-less-p
- remote-file-name-inhibit-cache (car cached)))))
- (setq value (cdr cached)
- cache-used t))
-
- (tramp-message
- key 8 "%s %s %s; inhibit: %s; cache used: %s; cached at: %s"
- file property value remote-file-name-inhibit-cache cache-used cached-at)
- ;; For analysis purposes, count the number of getting this file attribute.
- (when (>= tramp-verbose 10)
- (let* ((var (intern (concat "tramp-cache-get-count-" property)))
- (val (or (and (boundp var) (numberp (symbol-value var))
- (symbol-value var))
- 0)))
- (set var (1+ val))))
- value))
+ (setq key (tramp-file-name-unify key file))
+ (if (eq key tramp-cache-undefined) default
+ (let* ((hash (tramp-get-hash-table key))
+ (cached (and (hash-table-p hash) (gethash property hash)))
+ (cached-at
+ (and (consp cached) (format-time-string "%T" (car cached))))
+ (value default)
+ cache-used)
+
+ (when ;; We take the value only if there is any, and
+ ;; `remote-file-name-inhibit-cache' indicates that it is
+ ;; still valid. Otherwise, DEFAULT is set.
+ (and (consp cached)
+ (or (null remote-file-name-inhibit-cache)
+ (and (integerp remote-file-name-inhibit-cache)
+ (time-less-p
+ nil
+ (time-add (car cached)
remote-file-name-inhibit-cache)))
+ (and (consp remote-file-name-inhibit-cache)
+ (time-less-p
+ remote-file-name-inhibit-cache (car cached)))))
+ (setq value (cdr cached)
+ cache-used t))
+
+ (tramp-message
+ key 8 "%s %s %s; inhibit: %s; cache used: %s; cached at: %s"
+ (tramp-file-name-localname key)
+ property value remote-file-name-inhibit-cache cache-used cached-at)
+ ;; For analysis purposes, count the number of getting this file
attribute.
+ (when (>= tramp-verbose 10)
+ (let* ((var (intern (concat "tramp-cache-get-count-" property)))
+ (val (or (and (boundp var) (numberp (symbol-value var))
+ (symbol-value var))
+ 0)))
+ (set var (1+ val))))
+ value)))
(add-hook 'tramp-cache-unload-hook
(lambda ()
@@ -182,86 +189,87 @@ Return DEFAULT if not set."
"Set the PROPERTY of FILE to VALUE, in the cache context of KEY.
Return VALUE."
;; Unify localname. Remove hop from `tramp-file-name' structure.
- (setq 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)
- (tramp-message key 8 "%s %s %s" file property value)
- ;; For analysis purposes, count the number of setting this file attribute.
- (when (>= tramp-verbose 10)
- (let* ((var (intern (concat "tramp-cache-set-count-" property)))
- (val (or (and (boundp var) (numberp (symbol-value var))
- (symbol-value var))
- 0)))
- (set var (1+ val))))
- value))
+ (setq key (tramp-file-name-unify key file))
+ (if (eq key tramp-cache-undefined) value
+ (let ((hash (tramp-get-hash-table key)))
+ ;; We put the timestamp there.
+ (puthash property (cons (current-time) value) hash)
+ (tramp-message
+ key 8 "%s %s %s" (tramp-file-name-localname key) property value)
+ ;; For analysis purposes, count the number of setting this file
attribute.
+ (when (>= tramp-verbose 10)
+ (let* ((var (intern (concat "tramp-cache-set-count-" property)))
+ (val (or (and (boundp var) (numberp (symbol-value var))
+ (symbol-value var))
+ 0)))
+ (set var (1+ val))))
+ value)))
(add-hook 'tramp-cache-unload-hook
(lambda ()
(dolist (var (all-completions "tramp-cache-set-count-" obarray))
(unintern var obarray))))
+;;;###tramp-autoload
+(defun tramp-file-property-p (key file property)
+ "Check whether PROPERTY of FILE is defined in the cache context of KEY."
+ (and
+ (not (eq key tramp-cache-undefined))
+ (not (eq (tramp-get-file-property key file property tramp-cache-undefined)
+ tramp-cache-undefined))))
+
;;;###tramp-autoload
(defun tramp-flush-file-property (key file property)
"Remove PROPERTY of FILE in the cache context of KEY."
;; Unify localname. Remove hop from `tramp-file-name' structure.
- (setq 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)
- (remhash property (tramp-get-hash-table key))
- (tramp-message key 8 "%s %s" file property)
- (when (>= tramp-verbose 10)
- (let ((var (intern (concat "tramp-cache-set-count-" property))))
- (makunbound var))))
+ (setq key (tramp-file-name-unify key file))
+ (unless (eq key tramp-cache-undefined)
+ (remhash property (tramp-get-hash-table key))
+ (tramp-message key 8 "%s %s" (tramp-file-name-localname key) property)
+ (when (>= tramp-verbose 10)
+ (let ((var (intern (concat "tramp-cache-set-count-" property))))
+ (makunbound var)))))
(defun tramp-flush-file-upper-properties (key file)
"Remove some properties of FILE's upper directory."
(when (file-name-absolute-p file)
- (let ((file (directory-file-name (file-name-directory file))))
+ ;; `file-name-directory' can return nil, for example for "~".
+ (when-let ((file (file-name-directory file))
+ (file (directory-file-name file)))
;; Unify localname. Remove hop from `tramp-file-name' structure.
- (setq 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)
- (dolist (property (hash-table-keys (tramp-get-hash-table key)))
- (when (string-match-p
- "^\\(directory-\\|file-name-all-completions\\|file-entries\\)"
- property)
- (tramp-flush-file-property key file property))))))
+ (setq key (tramp-file-name-unify key file))
+ (unless (eq key tramp-cache-undefined)
+ (dolist (property (hash-table-keys (tramp-get-hash-table key)))
+ (when (string-match-p
+ (rx
+ bos (| "directory-" "file-name-all-completions"
+ "file-entries"))
+ property)
+ (tramp-flush-file-property key file property)))))))
;;;###tramp-autoload
(defun tramp-flush-file-properties (key file)
"Remove all properties of FILE in the cache context of KEY."
- (let* ((file (tramp-run-real-handler #'directory-file-name (list file)))
- (truename (tramp-get-file-property key file "file-truename" nil)))
+ (let ((truename (tramp-get-file-property key file "file-truename")))
;; 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.
- (when (and (stringp truename)
- (not (string-equal file (directory-file-name truename))))
- (tramp-flush-file-properties key truename))
- ;; Remove selected properties of upper directory.
- (tramp-flush-file-upper-properties key file)))
+ (setq key (tramp-file-name-unify key file))
+ (unless (eq key tramp-cache-undefined)
+ (tramp-message key 8 "%s" (tramp-file-name-localname key))
+ (remhash key tramp-cache-data)
+ ;; Remove file properties of symlinks.
+ (when (and (stringp truename)
+ (not (string-equal file (directory-file-name truename))))
+ (tramp-flush-file-properties key truename))
+ ;; Remove selected properties of upper directory.
+ (tramp-flush-file-upper-properties key file))))
;;;###tramp-autoload
(defun tramp-flush-directory-properties (key directory)
"Remove all properties of DIRECTORY in the cache context of KEY.
Remove also properties of all files in subdirectories."
- (setq directory (tramp-compat-file-name-unquote directory))
- (let* ((directory (tramp-run-real-handler
- #'directory-file-name (list directory)))
- (truename (tramp-get-file-property key directory "file-truename" nil)))
+ (let* ((directory
+ (directory-file-name (tramp-compat-file-name-unquote directory)))
+ (truename (tramp-get-file-property key directory "file-truename")))
(tramp-message key 8 "%s" directory)
(dolist (key (hash-table-keys tramp-cache-data))
(when (and (tramp-file-name-p key)
@@ -281,19 +289,20 @@ Remove also properties of all files in subdirectories."
;; not show proper directory contents when a file has been copied or
;; deleted before. We must apply `save-match-data', because it would
;; corrupt other packages otherwise (reported from org).
+;;;###tramp-autoload
(defun tramp-flush-file-function ()
"Flush all Tramp cache properties from `buffer-file-name'.
This is suppressed for temporary buffers."
(save-match-data
(unless (or (null (buffer-name))
- (string-match-p "^\\( \\|\\*\\)" (buffer-name)))
+ (string-match-p (rx bos (| blank "*")) (buffer-name)))
(let ((bfn (if (stringp (buffer-file-name))
(buffer-file-name)
default-directory))
(tramp-verbose 0))
(when (tramp-tramp-file-p bfn)
- (with-parsed-tramp-file-name bfn nil
- (tramp-flush-file-properties v localname)))))))
+ (tramp-flush-file-properties
+ (tramp-dissect-file-name bfn) (tramp-file-local-name bfn)))))))
(add-hook 'before-revert-hook #'tramp-flush-file-function)
(add-hook 'eshell-pre-command-hook #'tramp-flush-file-function)
@@ -307,10 +316,65 @@ This is suppressed for temporary buffers."
(remove-hook 'kill-buffer-hook
#'tramp-flush-file-function)))
+;;;###tramp-autoload
+(defmacro with-tramp-file-property (key file property &rest body)
+ "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache.
+FILE must be a local file name on a connection identified via KEY."
+ (declare (indent 3) (debug t))
+ `(let ((value (tramp-get-file-property
+ ,key ,file ,property tramp-cache-undefined)))
+ (when (eq value tramp-cache-undefined)
+ ;; We cannot pass @body as parameter to
+ ;; `tramp-set-file-property' because it mangles our debug
+ ;; messages.
+ (setq value (progn ,@body))
+ (tramp-set-file-property ,key ,file ,property value))
+ value))
+
+;;;###tramp-autoload
+(defmacro with-tramp-saved-file-property (key file property &rest body)
+ "Save PROPERTY, run BODY, reset PROPERTY.
+Preserve timestamps."
+ (declare (indent 3) (debug t))
+ `(progn
+ ;; Unify localname. Remove hop from `tramp-file-name' structure.
+ (setq ,key (tramp-file-name-unify ,key ,file))
+ (let* ((hash (tramp-get-hash-table ,key))
+ (cached (and (hash-table-p hash) (gethash ,property hash))))
+ (unwind-protect (progn ,@body)
+ ;; Reset PROPERTY. Recompute hash, it could have been flushed.
+ (setq hash (tramp-get-hash-table ,key))
+ (if (consp cached)
+ (puthash ,property cached hash)
+ (remhash ,property hash))))))
+
+;;;###tramp-autoload
+(defmacro with-tramp-saved-file-properties (key file properties &rest body)
+ "Save PROPERTIES, run BODY, reset PROPERTIES.
+PROPERTIES is a list of file properties (strings).
+Preserve timestamps."
+ (declare (indent 3) (debug t))
+ `(progn
+ ;; Unify localname. Remove hop from `tramp-file-name' structure.
+ (setq ,key (tramp-file-name-unify ,key ,file))
+ (let* ((hash (tramp-get-hash-table ,key))
+ (values
+ (and (hash-table-p hash)
+ (mapcar
+ (lambda (property) (cons property (gethash property hash)))
+ ,properties))))
+ (unwind-protect (progn ,@body)
+ ;; Reset PROPERTIES. Recompute hash, it could have been flushed.
+ (setq hash (tramp-get-hash-table ,key))
+ (dolist (value values)
+ (if (consp (cdr value))
+ (puthash (car value) (cdr value) hash)
+ (remhash (car value) hash)))))))
+
;;; -- Properties --
;;;###tramp-autoload
-(defun tramp-get-connection-property (key property default)
+(defun tramp-get-connection-property (key property &optional default)
"Get the named PROPERTY for the connection.
KEY identifies the connection, it is either a process or a
`tramp-file-name' structure. A special case is nil, which is
@@ -389,6 +453,57 @@ used to cache connection properties of the local machine."
(or tramp-cache-data-changed (tramp-file-name-p key)))
(remhash key tramp-cache-data))
+;;;###tramp-autoload
+(defmacro with-tramp-connection-property (key property &rest body)
+ "Check in Tramp for property PROPERTY, otherwise execute BODY and set."
+ (declare (indent 2) (debug t))
+ `(let ((value (tramp-get-connection-property
+ ,key ,property tramp-cache-undefined)))
+ (when (eq value tramp-cache-undefined)
+ ;; We cannot pass ,@body as parameter to
+ ;; `tramp-set-connection-property' because it mangles our debug
+ ;; messages.
+ (setq value (progn ,@body))
+ (tramp-set-connection-property ,key ,property value))
+ value))
+
+;;;###tramp-autoload
+(defmacro with-tramp-saved-connection-property (key property &rest body)
+ "Save PROPERTY, run BODY, reset PROPERTY."
+ (declare (indent 2) (debug t))
+ `(progn
+ (setq ,key (tramp-file-name-unify ,key))
+ (let* ((hash (tramp-get-hash-table ,key))
+ (cached (and (hash-table-p hash)
+ (gethash ,property hash tramp-cache-undefined))))
+ (unwind-protect (progn ,@body)
+ ;; Reset PROPERTY. Recompute hash, it could have been flushed.
+ (setq hash (tramp-get-hash-table ,key))
+ (if (not (eq cached tramp-cache-undefined))
+ (puthash ,property cached hash)
+ (remhash ,property hash))))))
+
+;;;###tramp-autoload
+(defmacro with-tramp-saved-connection-properties (key properties &rest body)
+ "Save PROPERTIES, run BODY, reset PROPERTIES.
+PROPERTIES is a list of file properties (strings)."
+ (declare (indent 2) (debug t))
+ `(progn
+ (setq ,key (tramp-file-name-unify ,key))
+ (let* ((hash (tramp-get-hash-table ,key))
+ (values
+ (mapcar
+ (lambda (property)
+ (cons property (gethash property hash tramp-cache-undefined)))
+ ,properties)))
+ (unwind-protect (progn ,@body)
+ ;; Reset PROPERTIES. Recompute hash, it could have been flushed.
+ (setq hash (tramp-get-hash-table ,key))
+ (dolist (value values)
+ (if (not (eq (cdr value) tramp-cache-undefined))
+ (puthash (car value) (cdr value) hash)
+ (remhash (car value) hash)))))))
+
;;;###tramp-autoload
(defun tramp-cache-print (table)
"Print hash table TABLE."
@@ -426,7 +541,7 @@ used to cache connection properties of the local machine."
;;;###tramp-autoload
(defun tramp-list-connections ()
- "Return all known `tramp-file-name' structs according to `tramp-cache'."
+ "Return all active `tramp-file-name' structs according to
`tramp-cache-data'."
(let ((tramp-verbose 0))
(delq nil (mapcar
(lambda (key)
@@ -486,19 +601,30 @@ used to cache connection properties of the local machine."
(remove-hook 'kill-emacs-hook
#'tramp-dump-connection-properties)))
+;;;###tramp-autoload
+(defcustom tramp-completion-use-cache t
+ "Whether to use the Tramp cache for completion of user and host names.
+Set it to nil if there are invalid entries in the cache, for
+example if the host configuration changes often, or if you plug
+your laptop to different networks frequently."
+ :group 'tramp
+ :version "29.1"
+ :type 'boolean)
+
;;;###tramp-autoload
(defun tramp-parse-connection-properties (method)
"Return a list of (user host) tuples allowed to access for METHOD.
This function is added always in `tramp-get-completion-function'
for all methods. Resulting data are derived from connection history."
- (mapcar
- (lambda (key)
- (and (tramp-file-name-p key)
- (string-equal method (tramp-file-name-method key))
- (not (tramp-file-name-localname key))
- (list (tramp-file-name-user key)
- (tramp-file-name-host key))))
- (hash-table-keys tramp-cache-data)))
+ (and tramp-completion-use-cache
+ (mapcar
+ (lambda (key)
+ (and (tramp-file-name-p key)
+ (string-equal method (tramp-file-name-method key))
+ (not (tramp-file-name-localname key))
+ (list (tramp-file-name-user key)
+ (tramp-file-name-host key))))
+ (hash-table-keys tramp-cache-data))))
;; When "emacs -Q" has been called, both variables are nil. We do not
;; load the persistency file then, in order to have a clean test environment.
@@ -525,9 +651,16 @@ for all methods. Resulting data are derived from
connection history."
;; initialized properly by side effect.
(unless (tramp-connection-property-p key (car item))
(tramp-set-connection-property key (pop item) (car item)))))))
+ ;; Check Tramp version. Clear cache in case of mismatch.
+ (unless (string-equal
+ (tramp-get-connection-property
+ tramp-cache-version "tramp-version" "")
+ tramp-version)
+ (signal 'file-error nil))
(setq tramp-cache-data-changed nil))
(file-error
- ;; Most likely because the file doesn't exist yet. No message.
+ ;; Most likely because the file doesn't exist yet, or the Tramp
+ ;; version doesn't match. No message.
(clrhash tramp-cache-data))
(error
;; File is corrupted.
@@ -535,6 +668,9 @@ for all methods. Resulting data are derived from
connection history."
tramp-persistency-file-name (error-message-string err))
(clrhash tramp-cache-data))))
+;; Initialize the cache version.
+(tramp-set-connection-property tramp-cache-version "tramp-version"
tramp-version)
+
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-cache 'force)))
diff --git a/tramp-cmds.el b/tramp-cmds.el
index 8e359c382b..0442fa7409 100644
--- a/tramp-cmds.el
+++ b/tramp-cmds.el
@@ -34,6 +34,7 @@
(declare-function mml-mode "mml")
(declare-function mml-insert-empty-tag "mml")
(declare-function reporter-dump-variable "reporter")
+(defvar mm-7bit-chars)
(defvar reporter-eval-buffer)
(defvar reporter-prompt-for-summary-p)
@@ -46,7 +47,7 @@ SYNTAX can be one of the symbols `default' (default),
(let ((input (completing-read
"Enter Tramp syntax: " (tramp-syntax-values) nil t
(symbol-name tramp-syntax))))
- (unless (string-equal input "")
+ (unless (string-empty-p input)
(list (intern input)))))
(when syntax
(customize-set-variable 'tramp-syntax syntax)))
@@ -69,7 +70,7 @@ SYNTAX can be one of the symbols `default' (default),
nil
(mapcar
(lambda (x)
- (with-current-buffer x (when (tramp-tramp-file-p default-directory) x)))
+ (when (tramp-tramp-file-p (tramp-get-default-directory x)) x))
(buffer-list))))
;;;###tramp-autoload
@@ -135,11 +136,11 @@ When called interactively, a Tramp connection has to be
selected."
(get-buffer (tramp-debug-buffer-name vec)))
(unless keep-debug
(get-buffer (tramp-trace-buffer-name vec)))
- (tramp-get-connection-property vec "process-buffer" nil)))
+ (tramp-get-connection-property vec "process-buffer")))
(when (bufferp buf) (kill-buffer buf)))
;; Flush file cache.
- (tramp-flush-directory-properties vec "")
+ (tramp-flush-directory-properties vec "/")
;; Flush connection cache.
(tramp-flush-connection-properties vec)
@@ -178,6 +179,10 @@ This includes password cache, file cache, connection
cache, buffers."
;; Flush file and connection cache.
(clrhash tramp-cache-data)
+ ;; Initialize the cache version.
+ (tramp-set-connection-property
+ tramp-cache-version "tramp-version" tramp-version)
+
;; Remove ad-hoc proxies.
(let ((proxies tramp-default-proxies-alist))
(while proxies
@@ -354,7 +359,7 @@ The remote connection identified by SOURCE is flushed by
(dir (tramp-rename-read-file-name-dir default))
(init (tramp-rename-read-file-name-init default))
(tramp-ignored-file-name-regexp
- (regexp-quote (file-remote-p source))))
+ (tramp-compat-rx (literal (file-remote-p source)))))
(read-file-name-default
"Enter new Tramp connection: "
dir default 'confirm init #'file-directory-p)))))
@@ -465,7 +470,7 @@ For details, see `tramp-rename-files'."
(dir (tramp-rename-read-file-name-dir default))
(init (tramp-rename-read-file-name-init default))
(tramp-ignored-file-name-regexp
- (regexp-quote (file-remote-p source))))
+ (tramp-compat-rx (literal (file-remote-p source)))))
(read-file-name-default
(format "Change Tramp connection `%s': " source)
dir default 'confirm init #'file-directory-p)))))
@@ -502,7 +507,7 @@ This is needed if there are compatibility problems."
((dir (tramp-compat-funcall
'package-desc-dir
(car (alist-get 'tramp (bound-and-true-p package-alist))))))
- (dolist (elc (directory-files dir 'full "\\.elc\\'"))
+ (dolist (elc (directory-files dir 'full (rx ".elc" eos)))
(delete-file elc))
(with-current-buffer (get-buffer-create byte-compile-log-buffer)
(let ((inhibit-read-only t))
@@ -595,9 +600,8 @@ buffer in your bug report.
(defun tramp-reporter-dump-variable (varsym mailbuf)
"Pretty-print the value of the variable in symbol VARSYM."
- (let* ((reporter-eval-buffer (symbol-value 'reporter-eval-buffer))
- (val (with-current-buffer reporter-eval-buffer
- (symbol-value varsym))))
+ (when-let ((reporter-eval-buffer reporter-eval-buffer)
+ (val (buffer-local-value varsym reporter-eval-buffer)))
(if (hash-table-p val)
;; Pretty print the cache.
@@ -605,7 +609,7 @@ buffer in your bug report.
;; There are non-7bit characters to be masked.
(when (and (stringp val)
(string-match-p
- (concat "[^" (bound-and-true-p mm-7bit-chars) "]") val))
+ (rx-to-string `(not (any ,mm-7bit-chars))) val))
(with-current-buffer reporter-eval-buffer
(set varsym
`(decode-coding-string
@@ -614,20 +618,22 @@ buffer in your bug report.
'raw-text)))))
;; Dump variable.
- (reporter-dump-variable varsym mailbuf)
+ (goto-char (point-max))
+ (save-excursion
+ (reporter-dump-variable varsym mailbuf))
(unless (hash-table-p val)
;; Remove string quotation.
- (forward-line -1)
(when (looking-at
- (concat "\\(^.*\\)" "\"" ;; \1 "
- "\\((base64-decode-string \\)" "\\\\" ;; \2 \
- "\\(\".*\\)" "\\\\" ;; \3 \
- "\\(\")\\)" "\"$")) ;; \4 "
+ (tramp-compat-rx
+ bol (group (* anychar)) "\"" ;; \1 "
+ (group "(base64-decode-string ") "\\" ;; \2 \
+ (group "\"" (* anychar)) "\\" ;; \3 \
+ (group "\")") "\"" eol)) ;; \4 "
(replace-match "\\1\\2\\3\\4")
(beginning-of-line)
- (insert " ;; Variable encoded due to non-printable characters.\n"))
- (forward-line 1))
+ (insert " ;; Variable encoded due to non-printable characters.\n")))
+ (goto-char (point-max))
;; Reset VARSYM to old value.
(with-current-buffer reporter-eval-buffer
@@ -657,21 +663,27 @@ buffer in your bug report.
(erase-buffer)
(insert (format "\n;; %s\n(setq-local\n" (buffer-name buffer)))
(lisp-indent-line)
- (dolist
- (varsym
- (sort
- (append
- (mapcar
- #'intern
- (all-completions "tramp-" (buffer-local-variables buffer)))
- ;; Non-tramp variables of interest.
- '(connection-local-variables-alist default-directory))
- #'string<))
- (reporter-dump-variable varsym elbuf))
+ (dolist (varsym
+ (sort
+ (append
+ (mapcar
+ #'intern
+ (all-completions "tramp-" (buffer-local-variables buffer)))
+ ;; Non-tramp variables of interest.
+ '(connection-local-variables-alist default-directory))
+ #'string<))
+ (reporter-dump-variable varsym elbuf))
(lisp-indent-line)
(insert ")\n"))
(insert-buffer-substring elbuf)))
+ ;; Beautify encoded values.
+ (goto-char (point-min))
+ (while (re-search-forward
+ (rx "'" (group "(decode-coding-string")) nil 'noerror)
+ (replace-match "\\1"))
+ (goto-char (point-max))
+
;; Dump load-path shadows.
(insert "\nload-path shadows:\n==================\n")
(ignore-errors
@@ -684,7 +696,7 @@ buffer in your bug report.
(eq major-mode 'message-mode)
(bound-and-true-p mml-mode))
- (let ((tramp-buf-regexp "\\*\\(debug \\)?tramp/")
+ (let ((tramp-buf-regexp (rx "*" (? "debug ") "tramp/"))
(buffer-list (tramp-list-tramp-buffers))
(curbuf (current-buffer)))
@@ -695,7 +707,7 @@ buffer in your bug report.
(setq buffer-read-only nil)
(goto-char (point-min))
(while (not (eobp))
- (if (re-search-forward tramp-buf-regexp (point-at-eol) t)
+ (if (re-search-forward tramp-buf-regexp (line-end-position) t)
(forward-line 1)
(forward-line 0)
(let ((start (point)))
@@ -723,7 +735,7 @@ the debug buffer(s).")
(when (y-or-n-p "Do you want to append the buffer(s)?")
;; OK, let's send. First we delete the buffer list.
- (kill-buffer nil)
+ (kill-buffer)
(switch-to-buffer curbuf)
(goto-char (point-max))
(insert (propertize "\n" 'display "\n\
diff --git a/tramp-compat.el b/tramp-compat.el
index 91c450eee4..252eab0f3b 100644
--- a/tramp-compat.el
+++ b/tramp-compat.el
@@ -23,27 +23,22 @@
;;; Commentary:
-;; Tramp's main Emacs version for development is Emacs 28. This
-;; package provides compatibility functions for Emacs 25, Emacs 26 and
-;; Emacs 27.
+;; Tramp's main Emacs version for development is Emacs 29. This
+;; package provides compatibility functions for Emacs 26, Emacs 27 and
+;; Emacs 28.
;;; Code:
-;; In Emacs 25, `tramp-unload-file-name-handlers' is not autoloaded.
-;; So we declare it here in order to avoid recursive load. This will
-;; be overwritten in tramp.el.
-(defun tramp-unload-file-name-handlers () ".")
-
(require 'auth-source)
(require 'format-spec)
-(require 'ls-lisp) ;; Due to `tramp-handle-insert-directory'.
+(require 'ls-lisp) ;; Due to `tramp-handle-insert-directory'.
(require 'parse-time)
(require 'shell)
(require 'subr-x)
+(declare-function tramp-compat-rx "tramp")
(declare-function tramp-error "tramp")
-;; `temporary-file-directory' as function is introduced with Emacs 26.1.
-(declare-function tramp-handle-temporary-file-directory "tramp")
+(declare-function tramp-file-name-handler "tramp")
(declare-function tramp-tramp-file-p "tramp")
(defvar tramp-temp-name-prefix)
@@ -55,6 +50,13 @@
(warn "Tramp has been compiled with Emacs %s, this is Emacs %s"
tramp-compat-emacs-compiled-version emacs-version))
+(with-eval-after-load 'docker-tramp
+ (warn (concat "Package `docker-tramp' has been obsoleted, "
+ "please use integrated package `tramp-container'")))
+(with-eval-after-load 'kubernetes-tramp
+ (warn (concat "Package `kubernetes-tramp' has been obsoleted, "
+ "please use integrated package `tramp-container'")))
+
;; For not existing functions, obsolete functions, or functions with a
;; changed argument list, there are compiler warnings. We want to
;; avoid them in cases we know what we do.
@@ -83,133 +85,20 @@ Add the extension of F, if existing."
tramp-temp-name-prefix tramp-compat-temporary-file-directory)
dir-flag (file-name-extension f t)))
-;; `temporary-file-directory' as function is introduced with Emacs 26.1.
-(defalias 'tramp-compat-temporary-file-directory-function
- (if (fboundp 'temporary-file-directory)
- #'temporary-file-directory
- #'tramp-handle-temporary-file-directory))
-
-;; `file-attribute-*' are introduced in Emacs 26.1.
-
-(defalias 'tramp-compat-file-attribute-type
- (if (fboundp 'file-attribute-type)
- #'file-attribute-type
- (lambda (attributes)
- "The type field in ATTRIBUTES returned by `file-attributes'.
-The value is either t for directory, string (name linked to) for
-symbolic link, or nil."
- (nth 0 attributes))))
-
-(defalias 'tramp-compat-file-attribute-link-number
- (if (fboundp 'file-attribute-link-number)
- #'file-attribute-link-number
- (lambda (attributes)
- "Return the number of links in ATTRIBUTES returned by `file-attributes'."
- (nth 1 attributes))))
-
-(defalias 'tramp-compat-file-attribute-user-id
- (if (fboundp 'file-attribute-user-id)
- #'file-attribute-user-id
- (lambda (attributes)
- "The UID field in ATTRIBUTES returned by `file-attributes'.
-This is either a string or a number. If a string value cannot be
-looked up, a numeric value, either an integer or a float, is
-returned."
- (nth 2 attributes))))
-
-(defalias 'tramp-compat-file-attribute-group-id
- (if (fboundp 'file-attribute-group-id)
- #'file-attribute-group-id
- (lambda (attributes)
- "The GID field in ATTRIBUTES returned by `file-attributes'.
-This is either a string or a number. If a string value cannot be
-looked up, a numeric value, either an integer or a float, is
-returned."
- (nth 3 attributes))))
-
-(defalias 'tramp-compat-file-attribute-access-time
- (if (fboundp 'file-attribute-access-time)
- #'file-attribute-access-time
- (lambda (attributes)
- "The last access time in ATTRIBUTES returned by `file-attributes'.
-This a Lisp timestamp in the style of `current-time'."
- (nth 4 attributes))))
-
-(defalias 'tramp-compat-file-attribute-modification-time
- (if (fboundp 'file-attribute-modification-time)
- #'file-attribute-modification-time
- (lambda (attributes)
- "The modification time in ATTRIBUTES returned by `file-attributes'.
-This is the time of the last change to the file's contents, and
-is a Lisp timestamp in the style of `current-time'."
- (nth 5 attributes))))
-
-(defalias 'tramp-compat-file-attribute-status-change-time
- (if (fboundp 'file-attribute-status-change-time)
- #'file-attribute-status-change-time
- (lambda (attributes)
- "The status modification time in ATTRIBUTES returned by
`file-attributes'.
-This is the time of last change to the file's attributes: owner
-and group, access mode bits, etc., and is a Lisp timestamp in the
-style of `current-time'."
- (nth 6 attributes))))
-
-(defalias 'tramp-compat-file-attribute-size
- (if (fboundp 'file-attribute-size)
- #'file-attribute-size
- (lambda (attributes)
- "The size (in bytes) in ATTRIBUTES returned by `file-attributes'.
-If the size is too large for a fixnum, this is a bignum in Emacs 27
-and later, and is a float in Emacs 26 and earlier."
- (nth 7 attributes))))
-
-(defalias 'tramp-compat-file-attribute-modes
- (if (fboundp 'file-attribute-modes)
- #'file-attribute-modes
- (lambda (attributes)
- "The file modes in ATTRIBUTES returned by `file-attributes'.
-This is a string of ten letters or dashes as in ls -l."
- (nth 8 attributes))))
-
-;; `file-missing' is introduced in Emacs 26.1.
-(defconst tramp-file-missing
- (if (get 'file-missing 'error-conditions) 'file-missing 'file-error)
- "The error symbol for the `file-missing' error.")
-
-(defsubst tramp-compat-file-missing (vec file)
- "Emit the `file-missing' error."
- (if (get 'file-missing 'error-conditions)
- (tramp-error vec tramp-file-missing file)
- (tramp-error vec tramp-file-missing "No such file or directory: %s" file)))
-
-;; `file-local-name', `file-name-quoted-p', `file-name-quote' and
-;; `file-name-unquote' are introduced in Emacs 26.1.
-(defalias 'tramp-compat-file-local-name
- (if (fboundp 'file-local-name)
- #'file-local-name
- (lambda (name)
- "Return the local name component of NAME.
-It returns a file name which can be used directly as argument of
-`process-file', `start-file-process', or `shell-command'."
- (or (file-remote-p name 'localname) name))))
-
;; `file-name-quoted-p', `file-name-quote' and `file-name-unquote' got
;; a second argument in Emacs 27.1.
+;;;###tramp-autoload
(defalias 'tramp-compat-file-name-quoted-p
- (if (and
- (fboundp 'file-name-quoted-p)
- (equal (tramp-compat-funcall 'func-arity #'file-name-quoted-p) '(1 .
2)))
+ (if (equal (func-arity #'file-name-quoted-p) '(1 . 2))
#'file-name-quoted-p
(lambda (name &optional top)
"Whether NAME is quoted with prefix \"/:\".
If NAME is a remote file name and TOP is nil, check the local part of NAME."
(let ((file-name-handler-alist (unless top file-name-handler-alist)))
- (string-prefix-p "/:" (tramp-compat-file-local-name name))))))
+ (string-prefix-p "/:" (file-local-name name))))))
(defalias 'tramp-compat-file-name-quote
- (if (and
- (fboundp 'file-name-quote)
- (equal (tramp-compat-funcall 'func-arity #'file-name-quote) '(1 . 2)))
+ (if (equal (func-arity #'file-name-quote) '(1 . 2))
#'file-name-quote
(lambda (name &optional top)
"Add the quotation prefix \"/:\" to file NAME.
@@ -217,20 +106,17 @@ If NAME is a remote file name and TOP is nil, the local
part of NAME is quoted."
(let ((file-name-handler-alist (unless top file-name-handler-alist)))
(if (tramp-compat-file-name-quoted-p name top)
name
- (concat
- (file-remote-p name) "/:" (tramp-compat-file-local-name name)))))))
+ (concat (file-remote-p name) "/:" (file-local-name name)))))))
(defalias 'tramp-compat-file-name-unquote
- (if (and
- (fboundp 'file-name-unquote)
- (equal (tramp-compat-funcall 'func-arity #'file-name-unquote) '(1 . 2)))
+ (if (equal (func-arity #'file-name-unquote) '(1 . 2))
#'file-name-unquote
(lambda (name &optional top)
"Remove quotation prefix \"/:\" from file NAME.
If NAME is a remote file name and TOP is nil, the local part of
NAME is unquoted."
(let* ((file-name-handler-alist (unless top file-name-handler-alist))
- (localname (tramp-compat-file-local-name name)))
+ (localname (file-local-name name)))
(when (tramp-compat-file-name-quoted-p localname top)
(setq
localname (if (= (length localname) 2) "/" (substring localname 2))))
@@ -257,8 +143,8 @@ NAME is unquoted."
#'exec-path
(lambda ()
"List of directories to search programs to run in remote subprocesses."
- (if-let ((handler (find-file-name-handler default-directory 'exec-path)))
- (funcall handler 'exec-path)
+ (if (tramp-tramp-file-p default-directory)
+ (tramp-file-name-handler 'exec-path)
exec-path))))
;; `time-equal-p' has appeared in Emacs 27.1.
@@ -288,13 +174,12 @@ A nil value for either argument stands for the current
time."
;; `progress-reporter-update' got argument SUFFIX in Emacs 27.1.
(defalias 'tramp-compat-progress-reporter-update
- (if (equal (tramp-compat-funcall 'func-arity #'progress-reporter-update)
- '(1 . 3))
+ (if (equal (func-arity #'progress-reporter-update) '(1 . 3))
#'progress-reporter-update
(lambda (reporter &optional value _suffix)
(progress-reporter-update reporter value))))
-;; `ignore-error' is new in Emacs Emacs 27.1.
+;; `ignore-error' is new in Emacs 27.1.
(defmacro tramp-compat-ignore-error (condition &rest body)
"Execute BODY; if the error CONDITION occurs, return nil.
Otherwise, return result of last form in BODY.
@@ -303,22 +188,66 @@ CONDITION can also be a list of error conditions."
(declare (debug t) (indent 1))
`(condition-case nil (progn ,@body) (,condition nil)))
+;; `rx' in Emacs 26 doesn't know the `literal', `anychar' and
+;; `multibyte' constructs. The `not' construct requires an `any'
+;; construct as argument. The `regexp' construct requires a literal
+;; string.
+(defvar tramp-compat-rx--runtime-params)
+
+(defun tramp-compat-rx--transform-items (items)
+ (mapcar #'tramp-compat-rx--transform-item items))
+
+;; There is an error in Emacs 26. `(rx "a" (? ""))' => "a?".
+;; We must protect the string in regexp and literal, therefore.
+(defun tramp-compat-rx--transform-item (item)
+ (pcase item
+ ('anychar 'anything)
+ ('multibyte 'nonascii)
+ (`(not ,expr)
+ (if (consp expr) item (list 'not (list 'any expr))))
+ (`(regexp ,expr)
+ (setq tramp-compat-rx--runtime-params t)
+ `(regexp ,(list '\, `(concat "\\(?:" ,expr "\\)"))))
+ (`(literal ,expr)
+ (setq tramp-compat-rx--runtime-params t)
+ `(regexp ,(list '\, `(concat "\\(?:" (regexp-quote ,expr) "\\)"))))
+ (`(eval . ,_) item)
+ (`(,head . ,rest) (cons head (tramp-compat-rx--transform-items rest)))
+ (_ item)))
+
+(defun tramp-compat-rx--transform (items)
+ (let* ((tramp-compat-rx--runtime-params nil)
+ (new-rx (cons ': (tramp-compat-rx--transform-items items))))
+ (if tramp-compat-rx--runtime-params
+ `(rx-to-string ,(list '\` new-rx) t)
+ (rx-to-string new-rx t))))
+
+(if (ignore-errors (rx-to-string '(literal "a"))) ;; Emacs 27+.
+ (defalias 'tramp-compat-rx #'rx)
+ (defmacro tramp-compat-rx (&rest items)
+ (tramp-compat-rx--transform items)))
+
+;; This is needed for compilation in the Emacs source tree.
+;;;###autoload (defalias 'tramp-compat-rx #'rx)
+
+(put #'tramp-compat-rx 'tramp-autoload t)
+
;; `file-modes', `set-file-modes' and `set-file-times' got argument
;; FLAG in Emacs 28.1.
(defalias 'tramp-compat-file-modes
- (if (equal (tramp-compat-funcall 'func-arity #'file-modes) '(1 . 2))
+ (if (equal (func-arity #'file-modes) '(1 . 2))
#'file-modes
(lambda (filename &optional _flag)
(file-modes filename))))
(defalias 'tramp-compat-set-file-modes
- (if (equal (tramp-compat-funcall 'func-arity #'set-file-modes) '(2 . 3))
+ (if (equal (func-arity #'set-file-modes) '(2 . 3))
#'set-file-modes
(lambda (filename mode &optional _flag)
(set-file-modes filename mode))))
(defalias 'tramp-compat-set-file-times
- (if (equal (tramp-compat-funcall 'func-arity #'set-file-times) '(1 . 3))
+ (if (equal (func-arity #'set-file-times) '(1 . 3))
#'set-file-times
(lambda (filename &optional timestamp _flag)
(set-file-times filename timestamp))))
@@ -326,14 +255,13 @@ CONDITION can also be a list of error conditions."
;; `directory-files' and `directory-files-and-attributes' got argument
;; COUNT in Emacs 28.1.
(defalias 'tramp-compat-directory-files
- (if (equal (tramp-compat-funcall 'func-arity #'directory-files) '(1 . 5))
+ (if (equal (func-arity #'directory-files) '(1 . 5))
#'directory-files
(lambda (directory &optional full match nosort _count)
(directory-files directory full match nosort))))
(defalias 'tramp-compat-directory-files-and-attributes
- (if (equal (tramp-compat-funcall 'func-arity
#'directory-files-and-attributes)
- '(1 . 6))
+ (if (equal (func-arity #'directory-files-and-attributes) '(1 . 6))
#'directory-files-and-attributes
(lambda (directory &optional full match nosort id-format _count)
(directory-files-and-attributes directory full match nosort id-format))))
@@ -359,7 +287,7 @@ CONDITION can also be a list of error conditions."
(if (fboundp 'string-replace)
#'string-replace
(lambda (from-string to-string in-string)
- (let ((case-fold-search nil))
+ (let (case-fold-search)
(replace-regexp-in-string
(regexp-quote from-string) to-string in-string t t)))))
@@ -368,7 +296,7 @@ CONDITION can also be a list of error conditions."
(if (fboundp 'string-search)
#'string-search
(lambda (needle haystack &optional start-pos)
- (let ((case-fold-search nil))
+ (let (case-fold-search)
(string-match-p (regexp-quote needle) haystack start-pos)))))
;; Function `make-lock-file-name' is new in Emacs 28.1.
@@ -398,6 +326,62 @@ CONDITION can also be a list of error conditions."
(car components))
(cdr components)))))))
+;; `permission-denied' is introduced in Emacs 29.1.
+(defconst tramp-permission-denied
+ (if (get 'permission-denied 'error-conditions) 'permission-denied
'file-error)
+ "The error symbol for the `permission-denied' error.")
+
+(defsubst tramp-compat-permission-denied (vec file)
+ "Emit the `permission-denied' error."
+ (if (get 'permission-denied 'error-conditions)
+ (tramp-error vec tramp-permission-denied file)
+ (tramp-error vec tramp-permission-denied "Permission denied: %s" file)))
+
+;; Function `auth-info-password' is new in Emacs 29.1.
+(defalias 'tramp-compat-auth-info-password
+ (if (fboundp 'auth-info-password)
+ #'auth-info-password
+ (lambda (auth-info)
+ (let ((secret (plist-get auth-info :secret)))
+ (while (functionp secret)
+ (setq secret (funcall secret)))
+ secret))))
+
+;; Function `take' is new in Emacs 29.1.
+(defalias 'tramp-compat-take
+ (if (fboundp 'take)
+ #'take
+ (lambda (n list)
+ (when (and (natnump n) (> n 0))
+ (if (>= n (length list))
+ list (butlast list (- (length list) n)))))))
+
+;; Function `ntake' is new in Emacs 29.1.
+(defalias 'tramp-compat-ntake
+ (if (fboundp 'ntake)
+ #'ntake
+ (lambda (n list)
+ (when (and (natnump n) (> n 0))
+ (if (>= n (length list))
+ list (nbutlast list (- (length list) n)))))))
+
+;; Function `string-equal-ignore-case' is new in Emacs 29.1.
+(defalias 'tramp-compat-string-equal-ignore-case
+ (if (fboundp 'string-equal-ignore-case)
+ #'string-equal-ignore-case
+ (lambda (string1 string2)
+ (eq t (compare-strings string1 nil nil string2 nil nil t)))))
+
+;; Function `auth-source-netrc-parse-all' is new in Emacs 29.1.
+;; `netrc-parse' has been obsoleted in parallel.
+(defalias 'tramp-compat-auth-source-netrc-parse-all
+ (if (fboundp 'auth-source-netrc-parse-all)
+ #'auth-source-netrc-parse-all
+ (lambda (&optional file)
+ (declare-function netrc-parse "netrc")
+ (autoload 'netrc-parse "netrc")
+ (netrc-parse file))))
+
;; Function `replace-regexp-in-region' is new in Emacs 28.1.
(defalias 'tramp-compat-replace-regexp-in-region
(if (fboundp 'replace-regexp-in-region)
@@ -433,12 +417,10 @@ CONDITION can also be a list of error conditions."
;;; TODO:
;;
-;; * `func-arity' exists since Emacs 26.1.
-;;
;; * Starting with Emacs 27.1, there's no need to escape open
;; parentheses with a backslash in docstrings anymore.
;;
;; * Starting with Emacs 27.1, there's `make-empty-file'. Could be
-;; used instead of `write-region'.
+;; used instead of `(write-region "" ...)'.
;;; tramp-compat.el ends here
diff --git a/tramp-container.el b/tramp-container.el
new file mode 100644
index 0000000000..7b94253226
--- /dev/null
+++ b/tramp-container.el
@@ -0,0 +1,214 @@
+;;; tramp-container.el --- Tramp integration for Docker-like containers -*-
lexical-binding: t; -*-
+
+;; Copyright © 2022 Free Software Foundation, Inc.
+
+;; Author: Brian Cully <bjc@kublai.com>
+;; Keywords: comm, processes
+;; Package: tramp
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Allows Tramp access to environments provided by Docker and similar
+;; programs.
+;;
+;; ## Usage
+;;
+;; Open a file on a running Docker container:
+;;
+;; C-x C-f /docker:USER@CONTAINER:/path/to/file
+;;
+;; or Podman:
+;;
+;; C-x C-f /podman:USER@CONTAINER:/path/to/file
+;;
+;; Where:
+;; USER is the user on the container to connect as (optional)
+;; CONTAINER is the container to connect to
+;;
+;;
+;; Open file in a Kubernetes container:
+;;
+;; C-x C-f /kubernetes:POD:/path/to/file
+;;
+;; Where:
+;; POD is the pod to connect to.
+;; By default, the first container in that pod will be
+;; used.
+;;
+;; Completion for POD and accessing it operate in the current
+;; namespace, use this command to change it:
+;;
+;; "kubectl config set-context --current --namespace=<name>"
+
+;;; Code:
+
+(require 'tramp)
+
+;;;###tramp-autoload
+(defcustom tramp-docker-program "docker"
+ "Name of the Docker client program."
+ :group 'tramp
+ :version "29.1"
+ :type '(choice (const "docker")
+ (string)))
+
+;;;###tramp-autoload
+(defcustom tramp-podman-program "podman"
+ "Name of the Podman client program."
+ :group 'tramp
+ :version "29.1"
+ :type '(choice (const "podman")
+ (string)))
+
+;;;###tramp-autoload
+(defcustom tramp-kubernetes-program "kubectl"
+ "Name of the Kubernetes client program."
+ :group 'tramp
+ :version "29.1"
+ :type '(choice (const "kubectl")
+ (string)))
+
+;;;###tramp-autoload
+(defconst tramp-docker-method "docker"
+ "Tramp method name to use to connect to Docker containers.")
+
+;;;###tramp-autoload
+(defconst tramp-podman-method "podman"
+ "Tramp method name to use to connect to Podman containers.")
+
+;;;###tramp-autoload
+(defconst tramp-kubernetes-method "kubernetes"
+ "Tramp method name to use to connect to Kubernetes containers.")
+
+;;;###tramp-autoload
+(defun tramp-docker--completion-function (&rest _args)
+ "List Docker-like containers available for connection.
+
+This function is used by `tramp-set-completion-function', please
+see its function help for a description of the format."
+ (when-let ((default-directory tramp-compat-temporary-file-directory)
+ (raw-list (shell-command-to-string
+ (concat tramp-docker-program
+ " ps --format '{{.ID}}\t{{.Names}}'")))
+ (lines (split-string raw-list "\n" 'omit))
+ (names (mapcar
+ (lambda (line)
+ (when (string-match
+ (rx bol (group (1+ nonl))
+ "\t" (? (group (1+ nonl))) eol)
+ line)
+ (or (match-string 2 line) (match-string 1 line))))
+ lines)))
+ (mapcar (lambda (m) (list nil m)) (delq nil names))))
+
+;;;###tramp-autoload
+(defun tramp-kubernetes--completion-function (&rest _args)
+ "List Kubernetes pods available for connection.
+
+This function is used by `tramp-set-completion-function', please
+see its function help for a description of the format."
+ (when-let ((default-directory tramp-compat-temporary-file-directory)
+ (raw-list (shell-command-to-string
+ (concat tramp-kubernetes-program
+ " get pods --no-headers "
+ "-o custom-columns=NAME:.metadata.name")))
+ (names (split-string raw-list "\n" 'omit)))
+ (mapcar (lambda (name)
+ (list nil name))
+ names)))
+
+(defun tramp-kubernetes--current-context-data (vec)
+ "Return Kubernetes current context data as JSON string."
+ (with-temp-buffer
+ (when (zerop
+ (tramp-call-process
+ vec tramp-kubernetes-program nil t nil
+ "config" "current-context"))
+ (goto-char (point-min))
+ (let ((current-context (buffer-substring (point) (line-end-position))))
+ (erase-buffer)
+ (when (zerop
+ (tramp-call-process
+ vec tramp-kubernetes-program nil t nil
+ "config" "view" "-o"
+ (format
+ "jsonpath='{.contexts[?(@.name == \"%s\")]}'"
current-context)))
+ (buffer-string))))))
+
+;;;###tramp-autoload
+(defvar tramp-default-remote-shell) ;; Silence byte compiler.
+
+;;;###tramp-autoload
+(tramp--with-startup
+ (add-to-list 'tramp-methods
+ `(,tramp-docker-method
+ (tramp-login-program ,tramp-docker-program)
+ (tramp-login-args (("exec")
+ ("-it")
+ ("-u" "%u")
+ ("%h")
+ ("%l")))
+ (tramp-direct-async (,tramp-default-remote-shell "-c"))
+ (tramp-remote-shell ,tramp-default-remote-shell)
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-i" "-c"))))
+ (add-to-list 'tramp-methods
+ `(,tramp-podman-method
+ (tramp-login-program ,tramp-podman-program)
+ (tramp-login-args (("exec")
+ ("-it")
+ ("-u" "%u")
+ ("%h")
+ ("%l")))
+ (tramp-direct-async (,tramp-default-remote-shell "-c"))
+ (tramp-remote-shell ,tramp-default-remote-shell)
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-i" "-c"))))
+ (add-to-list 'tramp-methods
+ `(,tramp-kubernetes-method
+ (tramp-login-program ,tramp-kubernetes-program)
+ (tramp-login-args (("exec")
+ ("%h")
+ ("-it")
+ ("--")
+ ("%l")))
+ (tramp-config-check tramp-kubernetes--current-context-data)
+ (tramp-direct-async (,tramp-default-remote-shell "-c"))
+ (tramp-remote-shell ,tramp-default-remote-shell)
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-i" "-c"))))
+
+ (tramp-set-completion-function
+ tramp-docker-method
+ '((tramp-docker--completion-function "")))
+
+ (tramp-set-completion-function
+ tramp-podman-method
+ '((tramp-docker--completion-function "")))
+
+ (tramp-set-completion-function
+ tramp-kubernetes-method
+ '((tramp-kubernetes--completion-function ""))))
+
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-container 'force)))
+
+(provide 'tramp-container)
+
+;;; tramp-container.el ends here
diff --git a/tramp-crypt.el b/tramp-crypt.el
index 9588e6a1a8..249b3fcd4d 100644
--- a/tramp-crypt.el
+++ b/tramp-crypt.el
@@ -151,13 +151,14 @@ If NAME doesn't belong to an encrypted remote directory,
return nil."
(dolist (dir tramp-crypt-directories)
(and (string-prefix-p
dir (file-name-as-directory (expand-file-name name)))
- (throw 'crypt-file-name-p dir))))))
+ (throw 'crypt-file-name-p dir))))))
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-crypt-file-name-handler-alist
- '((access-file . tramp-crypt-handle-access-file)
+ '(;; `abbreviate-file-name' performed by default handler.
+ (access-file . tramp-crypt-handle-access-file)
(add-name-to-file . tramp-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
(copy-directory . tramp-handle-copy-directory)
@@ -208,6 +209,7 @@ If NAME doesn't belong to an encrypted remote directory,
return nil."
;; `get-file-buffer' performed by default handler.
(insert-directory . tramp-crypt-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
+ (list-system-processes . ignore)
(load . tramp-handle-load)
(lock-file . tramp-crypt-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
@@ -217,6 +219,8 @@ If NAME doesn't belong to an encrypted remote directory,
return nil."
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
(make-symbolic-link . tramp-handle-make-symbolic-link)
+ (memory-info . ignore)
+ (process-attributes . ignore)
(process-file . ignore)
(rename-file . tramp-crypt-handle-rename-file)
(set-file-acl . ignore)
@@ -228,7 +232,9 @@ If NAME doesn't belong to an encrypted remote directory,
return nil."
(start-file-process . ignore)
;; `substitute-in-file-name' performed by default handler.
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ ;; `tramp-get-home-directory' performed by default-handler.
;; `tramp-get-remote-gid' performed by default handler.
+ ;; `tramp-get-remote-groups' performed by default handler.
;; `tramp-get-remote-uid' performed by default handler.
(tramp-set-file-uid-gid . tramp-crypt-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore)
@@ -294,8 +300,8 @@ arguments to pass to the OPERATION."
(defun tramp-crypt-config-file-name (vec)
"Return the encfs config file name for VEC."
(expand-file-name
- (concat "tramp-" (tramp-file-name-host vec) tramp-crypt-encfs-config)
- user-emacs-directory))
+ (locate-user-emacs-file
+ (concat "tramp-" (tramp-file-name-host vec) tramp-crypt-encfs-config))))
(defun tramp-crypt-maybe-open-connection (vec)
"Maybe open a connection VEC.
@@ -312,7 +318,7 @@ connection if a previous connection has died for some
reason."
(process-put p 'vector vec)
(set-process-query-on-exit-flag p nil)))
- ;; The following operations must be performed w/o
+ ;; The following operations must be performed without
;; `tramp-crypt-file-name-handler'.
(let* (tramp-crypt-enabled
;; Don't check for a proper method.
@@ -322,7 +328,7 @@ connection if a previous connection has died for some
reason."
tramp-crypt-encfs-config (tramp-crypt-get-remote-dir vec)))
(local-config (tramp-crypt-config-file-name vec)))
;; There is no local encfs6 config file.
- (when (not (file-exists-p local-config))
+ (unless (file-exists-p local-config)
(if (and tramp-crypt-save-encfs-config-remote
(file-exists-p remote-config))
;; Copy remote encfs6 config file if possible.
@@ -422,7 +428,7 @@ Otherwise, return NAME."
(if (directory-name-p name) #'file-name-as-directory #'identity)
(concat
dir
- (unless (string-equal localname "/")
+ (unless (string-match-p (rx bos (? "/") eos) localname)
(with-tramp-file-property
crypt-vec localname (concat (symbol-name op) "-file-name")
(unless (tramp-crypt-send-command
@@ -433,7 +439,7 @@ Otherwise, return NAME."
(if (eq op 'encrypt) "Encoding" "Decoding") name))
(with-current-buffer (tramp-get-connection-buffer crypt-vec)
(goto-char (point-min))
- (buffer-substring (point-min) (point-at-eol)))))))
+ (buffer-substring (point-min) (line-end-position)))))))
;; Nothing to do.
name))
@@ -450,7 +456,7 @@ Otherwise, return NAME."
(defun tramp-crypt-do-encrypt-or-decrypt-file (op root infile outfile)
"Encrypt / decrypt file INFILE to OUTFILE according to encrypted directory
ROOT.
Both files must be local files. OP must be `encrypt' or `decrypt'.
-If OP ist `decrypt', the basename of INFILE must be an encrypted file name.
+If OP is `decrypt', the basename of INFILE must be an encrypted file name.
Raise an error if this fails."
(when-let ((tramp-crypt-enabled t)
(dir (tramp-crypt-file-name-p root))
@@ -485,6 +491,7 @@ See `tramp-crypt-do-encrypt-or-decrypt-file'."
Files in that directory and all subdirectories will be encrypted
before copying to, and decrypted after copying from that
directory. File names will be also encrypted."
+ ;; (declare (completion tramp-crypt-command-completion-p))
(interactive "DRemote directory name: ")
(unless tramp-crypt-enabled
(tramp-user-error nil "Feature is not enabled."))
@@ -549,7 +556,7 @@ localname."
(defun tramp-crypt-handle-access-file (filename string)
"Like `access-file' for Tramp files."
(let* ((encrypt-filename (tramp-crypt-encrypt-file-name filename))
- (encrypt-regexp (concat (regexp-quote encrypt-filename) "\\'"))
+ (encrypt-regexp (tramp-compat-rx (literal encrypt-filename) eos))
tramp-crypt-enabled)
(condition-case err
(access-file encrypt-filename string)
@@ -578,6 +585,7 @@ This function is invoked by `tramp-crypt-handle-copy-file'
and
`tramp-crypt-handle-rename-file'. It is an error if OP is
neither of `copy' and `rename'. FILENAME and NEWNAME must be
absolute file names."
+ ;; FILENAME and NEWNAME are already expanded.
(unless (memq op '(copy rename))
(error "Unknown operation `%s', must be `copy' or `rename'" op))
@@ -595,62 +603,61 @@ absolute file names."
(delete-directory filename 'recursive)))
(with-parsed-tramp-file-name (if t1 filename newname) nil
- (unless (file-exists-p filename)
- (tramp-compat-file-missing v filename))
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-error "File is a directory %s" newname))
-
- (with-tramp-progress-reporter
- v 0 (format "%s %s to %s" msg-operation filename newname)
- (if (and t1 t2 (string-equal t1 t2))
- ;; Both files are on the same encrypted remote directory.
- (let (tramp-crypt-enabled)
- (if (eq op 'copy)
- (copy-file
- encrypt-filename encrypt-newname ok-if-already-exists
- keep-date preserve-uid-gid preserve-extended-attributes)
- (rename-file
- encrypt-filename encrypt-newname ok-if-already-exists)))
-
- (let* ((tmpdir (tramp-compat-make-temp-file filename 'dir))
- (tmpfile1
- (expand-file-name
- (file-name-nondirectory encrypt-filename) tmpdir))
- (tmpfile2
- (expand-file-name
- (file-name-nondirectory encrypt-newname) tmpdir))
- tramp-crypt-enabled)
- (cond
- ;; Source and target file are on an encrypted remote directory.
- ((and t1 t2)
- (if (eq op 'copy)
- (copy-file
- encrypt-filename encrypt-newname ok-if-already-exists
- keep-date preserve-uid-gid preserve-extended-attributes)
- (rename-file
- encrypt-filename encrypt-newname ok-if-already-exists)))
- ;; Source file is on an encrypted remote directory.
- (t1
- (if (eq op 'copy)
- (copy-file
- encrypt-filename tmpfile1 t keep-date preserve-uid-gid
- preserve-extended-attributes)
- (rename-file encrypt-filename tmpfile1 t))
- (tramp-crypt-decrypt-file t1 tmpfile1 tmpfile2)
- (rename-file tmpfile2 newname ok-if-already-exists))
- ;; Target file is on an encrypted remote directory.
- (t2
- (if (eq op 'copy)
- (copy-file
- filename tmpfile1 t keep-date preserve-uid-gid
- preserve-extended-attributes)
- (rename-file filename tmpfile1 t))
- (tramp-crypt-encrypt-file t2 tmpfile1 tmpfile2)
- (rename-file tmpfile2 encrypt-newname ok-if-already-exists)))
- (delete-directory tmpdir 'recursive))))))
+ (tramp-barf-if-file-missing v filename
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-error "File is a directory %s" newname))
+
+ (with-tramp-progress-reporter
+ v 0 (format "%s %s to %s" msg-operation filename newname)
+ (if (and t1 t2 (string-equal t1 t2))
+ ;; Both files are on the same encrypted remote directory.
+ (let (tramp-crypt-enabled)
+ (if (eq op 'copy)
+ (copy-file
+ encrypt-filename encrypt-newname ok-if-already-exists
+ keep-date preserve-uid-gid preserve-extended-attributes)
+ (rename-file
+ encrypt-filename encrypt-newname ok-if-already-exists)))
+
+ (let* ((tmpdir (tramp-compat-make-temp-file filename 'dir))
+ (tmpfile1
+ (expand-file-name
+ (file-name-nondirectory encrypt-filename) tmpdir))
+ (tmpfile2
+ (expand-file-name
+ (file-name-nondirectory encrypt-newname) tmpdir))
+ tramp-crypt-enabled)
+ (cond
+ ;; Source and target file are on an encrypted remote directory.
+ ((and t1 t2)
+ (if (eq op 'copy)
+ (copy-file
+ encrypt-filename encrypt-newname ok-if-already-exists
+ keep-date preserve-uid-gid preserve-extended-attributes)
+ (rename-file
+ encrypt-filename encrypt-newname ok-if-already-exists)))
+ ;; Source file is on an encrypted remote directory.
+ (t1
+ (if (eq op 'copy)
+ (copy-file
+ encrypt-filename tmpfile1 t keep-date preserve-uid-gid
+ preserve-extended-attributes)
+ (rename-file encrypt-filename tmpfile1 t))
+ (tramp-crypt-decrypt-file t1 tmpfile1 tmpfile2)
+ (rename-file tmpfile2 newname ok-if-already-exists))
+ ;; Target file is on an encrypted remote directory.
+ (t2
+ (if (eq op 'copy)
+ (copy-file
+ filename tmpfile1 t keep-date preserve-uid-gid
+ preserve-extended-attributes)
+ (rename-file filename tmpfile1 t))
+ (tramp-crypt-encrypt-file t2 tmpfile1 tmpfile2)
+ (rename-file tmpfile2 encrypt-newname ok-if-already-exists)))
+ (delete-directory tmpdir 'recursive)))))))
(when (and t1 (eq op 'rename))
(with-parsed-tramp-file-name filename v1
@@ -697,36 +704,14 @@ absolute file names."
(defun tramp-crypt-handle-directory-files
(directory &optional full match nosort count)
"Like `directory-files' for Tramp files."
- (unless (file-exists-p directory)
- (tramp-compat-file-missing (tramp-dissect-file-name directory) directory))
- (when (file-directory-p directory)
- (setq directory (file-name-as-directory (expand-file-name directory)))
- (let* (tramp-crypt-enabled
- (result
- (directory-files (tramp-crypt-encrypt-file-name directory) 'full)))
- (setq result
- (mapcar (lambda (x) (tramp-crypt-decrypt-file-name x)) result))
- (when match
- (setq result
- (delq
- nil
- (mapcar
- (lambda (x)
- (when (string-match-p match (substring x (length directory)))
- x))
- result))))
- (unless full
- (setq result
- (mapcar
- (lambda (x)
- (replace-regexp-in-string
- (concat "^" (regexp-quote directory)) "" x))
- result)))
- (unless nosort
- (setq result (sort result #'string<)))
- (when (and (natnump count) (> count 0))
- (setq result (nbutlast result (- (length result) count))))
- result)))
+ (tramp-skeleton-directory-files directory full match nosort count
+ (let (tramp-crypt-enabled)
+ (mapcar
+ (lambda (x)
+ (replace-regexp-in-string
+ (tramp-compat-rx bos (literal directory)) ""
+ (tramp-crypt-decrypt-file-name x)))
+ (directory-files (tramp-crypt-encrypt-file-name directory) 'full)))))
(defun tramp-crypt-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
@@ -842,24 +827,21 @@ WILDCARD is not supported."
(defun tramp-crypt-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(let (tramp-crypt-enabled)
(tramp-compat-set-file-modes
(tramp-crypt-encrypt-file-name filename) mode flag))))
(defun tramp-crypt-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(let (tramp-crypt-enabled)
(tramp-compat-set-file-times
(tramp-crypt-encrypt-file-name filename) time flag))))
(defun tramp-crypt-handle-set-file-uid-gid (filename &optional uid gid)
"Like `tramp-set-file-uid-gid' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(let (tramp-crypt-enabled)
(tramp-set-file-uid-gid
(tramp-crypt-encrypt-file-name filename) uid gid))))
@@ -871,6 +853,14 @@ WILDCARD is not supported."
(tramp-compat-funcall
'unlock-file (tramp-crypt-encrypt-file-name filename))))
+(with-eval-after-load 'bookmark
+ (add-hook 'bookmark-inhibit-context-functions
+ #'tramp-crypt-file-name-p)
+ (add-hook 'tramp-crypt-unload-hook
+ (lambda ()
+ (remove-hook 'bookmark-inhibit-context-functions
+ #'tramp-crypt-file-name-p))))
+
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-crypt 'force)))
diff --git a/tramp-ftp.el b/tramp-ftp.el
index 650e839f82..ad736256ca 100644
--- a/tramp-ftp.el
+++ b/tramp-ftp.el
@@ -97,9 +97,9 @@ present for backward compatibility."
;; Add some defaults for `tramp-default-method-alist'.
(add-to-list 'tramp-default-method-alist
- (list "\\`ftp\\." nil tramp-ftp-method))
+ (list (rx bos "ftp.") nil tramp-ftp-method))
(add-to-list 'tramp-default-method-alist
- (list nil "\\`\\(anonymous\\|ftp\\)\\'" tramp-ftp-method))
+ (list nil (rx bos (| "anonymous" "ftp") eos) tramp-ftp-method))
;; Add completion function for FTP method.
(tramp-set-completion-function
@@ -125,7 +125,7 @@ pass to the OPERATION."
;; "ftp" method is used in the Tramp file name. So we unset
;; those values.
(ange-ftp-ftp-name-arg "")
- (ange-ftp-ftp-name-res nil))
+ ange-ftp-ftp-name-res)
(cond
;; If argument is a symlink, `file-directory-p' and
;; `file-exists-p' call the traversed file recursively. So we
@@ -135,12 +135,21 @@ pass to the OPERATION."
;; completion. We don't use `with-parsed-tramp-file-name',
;; because this returns another user but the one declared in
;; "~/.netrc".
+ ;; For file names which look like Tramp archive files like
+ ;; "/ftp:anonymous@ftp.gnu.org:/gnu/tramp/tramp-2.0.39.tar.gz",
+ ;; we must disable tramp-archive.el, because in
+ ;; `ange-ftp-get-files' this is "normalized" by
+ ;; `file-name-as-directory' with unwelcome side side-effects.
+ ;; This disables the file archive functionality, perhaps we
+ ;; could fix this otherwise. (Bug#56078)
((memq operation '(file-directory-p file-exists-p))
- (if (apply #'ange-ftp-hook-function operation args)
+ (cl-letf (((symbol-function #'tramp-archive-file-name-handler)
+ (lambda (operation &rest args)
+ (tramp-archive-run-real-handler operation args))))
+ (prog1 (apply #'ange-ftp-hook-function operation args)
(let ((v (tramp-dissect-file-name (car args) t)))
(setf (tramp-file-name-method v) tramp-ftp-method)
- (tramp-set-connection-property v "started" t))
- nil))
+ (tramp-set-connection-property v "started" t)))))
;; If the second argument of `copy-file' or `rename-file' is a
;; remote file name but via FTP, ange-ftp doesn't check this.
@@ -175,11 +184,10 @@ pass to the OPERATION."
;; It must be a `defsubst' in order to push the whole code into
;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
;;;###tramp-autoload
-(defsubst tramp-ftp-file-name-p (filename)
- "Check if it's a FILENAME that should be forwarded to Ange-FTP."
- (and (tramp-tramp-file-p filename)
- (string= (tramp-file-name-method (tramp-dissect-file-name filename))
- tramp-ftp-method)))
+(defsubst tramp-ftp-file-name-p (vec-or-filename)
+ "Check if it's a VEC-OR-FILENAME that should be forwarded to Ange-FTP."
+ (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
+ (string= (tramp-file-name-method vec) tramp-ftp-method)))
;;;###tramp-autoload
(tramp--with-startup
diff --git a/tramp-fuse.el b/tramp-fuse.el
index 7344c3c730..ea6b5a0622 100644
--- a/tramp-fuse.el
+++ b/tramp-fuse.el
@@ -51,43 +51,38 @@
"Remove hidden files from FILES."
(if tramp-fuse-remove-hidden-files
(cl-remove-if
- (lambda (x) (and (stringp x) (string-match-p "\\.fuse_hidden" x)))
+ (lambda (x) (and (stringp x) (string-match-p (rx ".fuse_hidden") x)))
files)
files))
(defun tramp-fuse-handle-directory-files
(directory &optional full match nosort count)
"Like `directory-files' for Tramp files."
- (unless (file-exists-p directory)
- (tramp-compat-file-missing (tramp-dissect-file-name directory) directory))
- (when (file-directory-p directory)
- (setq directory (file-name-as-directory (expand-file-name directory)))
- (with-parsed-tramp-file-name directory nil
- (let ((result
- (tramp-compat-directory-files
- (tramp-fuse-local-file-name directory) full match nosort count)))
+ (let ((result
+ (tramp-skeleton-directory-files directory full match nosort count
+ ;; Some storage systems do not return "." and "..".
+ (delete-dups
+ (append
+ '("." "..")
+ (tramp-fuse-remove-hidden-files
+ (tramp-compat-directory-files
+ (tramp-fuse-local-file-name directory))))))))
+ (if full
;; Massage the result.
- (when full
- (let ((local (concat "^" (regexp-quote (tramp-fuse-mount-point v))))
- (remote (directory-file-name
- (funcall
- (if (tramp-compat-file-name-quoted-p directory)
- #'tramp-compat-file-name-quote #'identity)
- (file-remote-p directory)))))
- (setq result
- (mapcar
- (lambda (x) (replace-regexp-in-string local remote x))
- result))))
- ;; Some storage systems do not return "." and "..".
- (dolist (item '(".." "."))
- (when (and (string-match-p (or match (regexp-quote item)) item)
- (not
- (member (if full (setq item (concat directory item)) item)
- result)))
- (setq result (cons item result))))
- ;; Return result.
- (tramp-fuse-remove-hidden-files
- (if nosort result (sort result #'string<)))))))
+ (let ((local (tramp-compat-rx
+ bol
+ (literal
+ (tramp-fuse-mount-point
+ (tramp-dissect-file-name directory)))))
+ (remote (directory-file-name
+ (funcall
+ (if (tramp-compat-file-name-quoted-p directory)
+ #'tramp-compat-file-name-quote #'identity)
+ (file-remote-p directory)))))
+ (mapcar
+ (lambda (x) (replace-regexp-in-string local remote x))
+ result))
+ result)))
(defun tramp-fuse-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
@@ -120,12 +115,6 @@
(unless (string-match-p elt item) (throw 'match nil)))
(setq result (cons (concat item "/") result)))))))))))
-(defun tramp-fuse-handle-file-readable-p (filename)
- "Like `file-readable-p' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-file-property v localname "file-readable-p"
- (file-readable-p (tramp-fuse-local-file-name filename)))))
-
;; This function isn't used.
(defun tramp-fuse-handle-insert-directory
(filename switches &optional wildcard full-directory-p)
@@ -159,7 +148,7 @@
(defun tramp-fuse-mount-point (vec)
"Return local mount point of VEC."
- (or (tramp-get-connection-property vec "mount-point" nil)
+ (or (tramp-get-connection-property vec "mount-point")
(expand-file-name
(concat
tramp-temp-name-prefix
@@ -183,7 +172,7 @@ It has the same meaning as
`remote-file-name-inhibit-cache'.")
;; cannot use `with-tramp-file-property', because we don't want to
;; cache a nil result.
(let ((remote-file-name-inhibit-cache tramp-fuse-mount-timeout))
- (or (tramp-get-file-property vec "/" "mounted" nil)
+ (or (tramp-get-file-property vec "/" "mounted")
(let* ((default-directory tramp-compat-temporary-file-directory)
(command (format "mount -t fuse.%s" (tramp-file-name-method
vec)))
(mount (shell-command-to-string command)))
@@ -191,8 +180,8 @@ It has the same meaning as
`remote-file-name-inhibit-cache'.")
(tramp-set-file-property
vec "/" "mounted"
(when (string-match
- (format
- "^\\(%s\\)\\s-" (regexp-quote (tramp-fuse-mount-spec vec)))
+ (tramp-compat-rx
+ bol (group (literal (tramp-fuse-mount-spec vec))) blank)
mount)
(match-string 1 mount)))))))
diff --git a/tramp-gvfs.el b/tramp-gvfs.el
index 207e588f34..da7641774f 100644
--- a/tramp-gvfs.el
+++ b/tramp-gvfs.el
@@ -122,10 +122,7 @@
(autoload 'zeroconf-init "zeroconf")
(tramp-compat-funcall 'dbus-get-unique-name :system)
(tramp-compat-funcall 'dbus-get-unique-name :session)
- (or ;; Until Emacs 25, `process-attributes' could crash Emacs
- ;; for some processes. Better we don't check.
- (<= emacs-major-version 25)
- (tramp-process-running-p "gvfs-fuse-daemon")
+ (or (tramp-process-running-p "gvfs-fuse-daemon")
(tramp-process-running-p "gvfsd-fuse"))))
"Non-nil when GVFS is available.")
@@ -319,6 +316,10 @@ It has been changed in GVFS 1.14.")
(defconst tramp-gvfs-password-anonymous-supported 16
"Operation supports anonymous users.")
+;; Since: 2.58
+(defconst tramp-gvfs-password-tcrypt 32
+ "Operation takes TCRYPT parameters.")
+
;; For the time being, we just need org.goa.Account and org.goa.Files
;; interfaces. We document the other ones, just in case.
@@ -413,9 +414,10 @@ It has been changed in GVFS 1.14.")
;; </interface>
(defconst tramp-goa-identity-regexp
- (concat "^" "\\(" tramp-user-regexp "\\)?"
- "@" "\\(" tramp-host-regexp "\\)?"
- "\\(?:" ":""\\(" tramp-port-regexp "\\)" "\\)?")
+ (tramp-compat-rx
+ bol (? (group (regexp tramp-user-regexp)))
+ "@" (? (group (regexp tramp-host-regexp)))
+ (? ":" (group (regexp tramp-port-regexp))))
"Regexp matching GNOME Online Accounts \"PresentationIdentity\" property.")
(defconst tramp-goa-interface-mail "org.gnome.OnlineAccounts.Mail"
@@ -471,8 +473,7 @@ It has been changed in GVFS 1.14.")
;; </method>
;; </interface>
-;; The basic structure for GNOME Online Accounts. We use a list :type,
-;; in order to be compatible with Emacs 25.
+;; The basic structure for GNOME Online Accounts.
(cl-defstruct (tramp-goa-account (:type list) :named) method user host port)
;;;###tramp-autoload
@@ -672,8 +673,7 @@ It has been changed in GVFS 1.14.")
;; STRING key (always-call-mount, is-removable, ...)
;; VARIANT value (boolean?)
-;; The basic structure for media devices. We use a list :type, in
-;; order to be compatible with Emacs 25.
+;; The basic structure for media devices.
(cl-defstruct (tramp-media-device (:type list) :named) method host port)
;; "gvfs-<command>" utilities have been deprecated in GVFS 1.31.1. We
@@ -690,7 +690,7 @@ It has been changed in GVFS 1.14.")
("gvfs-set-attribute" . "set"))
"List of cons cells, mapping \"gvfs-<command>\" to \"gio <command>\".")
-;; <http://www.pygtk.org/docs/pygobject/gio-constants.html>
+;; <https://www.pygtk.org/docs/pygobject/gio-constants.html>
(eval-and-compile
(defconst tramp-gvfs-file-attributes
'("name"
@@ -715,15 +715,16 @@ It has been changed in GVFS 1.14.")
"unix::device")
"GVFS file attributes."))
-(eval-and-compile
- (defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp
- (concat "[[:blank:]]" (regexp-opt tramp-gvfs-file-attributes t)
"=\\(.+?\\)")
- "Regexp to parse GVFS file attributes with `gvfs-ls'."))
+(defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp
+ (tramp-compat-rx
+ blank (group (regexp (regexp-opt tramp-gvfs-file-attributes)))
+ "=" (group (+? nonl)))
+ "Regexp to parse GVFS file attributes with `gvfs-ls'.")
(defconst tramp-gvfs-file-attributes-with-gvfs-info-regexp
- (concat "^[[:blank:]]*"
- (regexp-opt tramp-gvfs-file-attributes t)
- ":[[:blank:]]+\\(.*\\)$")
+ (tramp-compat-rx
+ bol (* blank) (group (regexp (regexp-opt tramp-gvfs-file-attributes)))
+ ":" (+ blank) (group (* nonl)) eol)
"Regexp to parse GVFS file attributes with `gvfs-info'.")
(defconst tramp-gvfs-file-system-attributes
@@ -733,23 +734,25 @@ It has been changed in GVFS 1.14.")
"GVFS file system attributes.")
(defconst tramp-gvfs-file-system-attributes-regexp
- (concat "^[[:blank:]]*"
- (regexp-opt tramp-gvfs-file-system-attributes t)
- ":[[:blank:]]+\\(.*\\)$")
+ (tramp-compat-rx
+ bol (* blank)
+ (group (regexp (regexp-opt tramp-gvfs-file-system-attributes)))
+ ":" (+ blank) (group (* nonl)) eol)
"Regexp to parse GVFS file system attributes with `gvfs-info'.")
(defconst tramp-gvfs-nextcloud-default-prefix "/remote.php/webdav"
"Default prefix for owncloud / nextcloud methods.")
(defconst tramp-gvfs-nextcloud-default-prefix-regexp
- (concat (regexp-quote tramp-gvfs-nextcloud-default-prefix) "$")
+ (tramp-compat-rx (literal tramp-gvfs-nextcloud-default-prefix) eol)
"Regexp of default prefix for owncloud / nextcloud methods.")
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-gvfs-file-name-handler-alist
- '((access-file . tramp-handle-access-file)
+ '((abbreviate-file-name . tramp-handle-abbreviate-file-name)
+ (access-file . tramp-handle-access-file)
(add-name-to-file . tramp-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
(copy-directory . tramp-handle-copy-directory)
@@ -800,6 +803,7 @@ It has been changed in GVFS 1.14.")
;; `get-file-buffer' performed by default handler.
(insert-directory . tramp-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
+ (list-system-processes . ignore)
(load . tramp-handle-load)
(lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
@@ -809,6 +813,8 @@ It has been changed in GVFS 1.14.")
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
(make-symbolic-link . tramp-handle-make-symbolic-link)
+ (memory-info . ignore)
+ (process-attributes . ignore)
(process-file . ignore)
(rename-file . tramp-gvfs-handle-rename-file)
(set-file-acl . ignore)
@@ -820,7 +826,9 @@ It has been changed in GVFS 1.14.")
(start-file-process . ignore)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-home-directory . tramp-gvfs-handle-get-home-directory)
(tramp-get-remote-gid . tramp-gvfs-handle-get-remote-gid)
+ (tramp-get-remote-groups . ignore)
(tramp-get-remote-uid . tramp-gvfs-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-gvfs-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore)
@@ -834,12 +842,11 @@ Operations not mentioned here will be handled by the
default Emacs primitives.")
;; It must be a `defsubst' in order to push the whole code into
;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
;;;###tramp-autoload
-(defsubst tramp-gvfs-file-name-p (filename)
- "Check if it's a FILENAME handled by the GVFS daemon."
- (and (tramp-tramp-file-p filename)
- (let ((method
- (tramp-file-name-method (tramp-dissect-file-name filename))))
- (and (stringp method) (member method tramp-gvfs-methods)))))
+(defsubst tramp-gvfs-file-name-p (vec-or-filename)
+ "Check if it's a VEC-OR-FILENAME handled by the GVFS daemon."
+ (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
+ (let ((method (tramp-file-name-method vec)))
+ (and (stringp method) (member method tramp-gvfs-methods)))))
(defvar tramp-gvfs-dbus-event-vector)
@@ -870,7 +877,7 @@ arguments to pass to the OPERATION."
(defun tramp-gvfs-dbus-string-to-byte-array (string)
"Like `dbus-string-to-byte-array' but add trailing \\0 if needed."
(dbus-string-to-byte-array
- (if (string-match-p "^(aya{sv})" tramp-gvfs-mountlocation-signature)
+ (if (string-match-p (rx bol "(aya{sv})") tramp-gvfs-mountlocation-signature)
(concat string (string 0)) string)))
(defun tramp-gvfs-dbus-byte-array-to-string (byte-array)
@@ -904,7 +911,7 @@ The call will be traced by Tramp with trace level 6."
(let (result)
(tramp-message vec 6 "%s" (cons func args))
(setq result (apply func args))
- (tramp-message vec 6 "%s" result(tramp-gvfs-stringify-dbus-message result))
+ (tramp-message vec 6 "%s" (tramp-gvfs-stringify-dbus-message result))
result))
(put #'tramp-dbus-function 'tramp-suppress-trace t)
@@ -927,8 +934,6 @@ or `dbus-call-method-asynchronously'."
;; when loading.
(dbus-ignore-errors (tramp-dbus-function ,vec func args))))
-(font-lock-add-keywords 'emacs-lisp-mode
'("\\<with-tramp-dbus-call-method\\>"))
-
(defmacro with-tramp-dbus-get-all-properties
(vec bus service path interface)
"Return all properties of INTERFACE.
@@ -943,8 +948,6 @@ The call will be traced by Tramp with trace level 6."
(tramp-dbus-function
,vec #'dbus-get-all-properties (list ,bus ,service ,path ,interface))))
-(font-lock-add-keywords 'emacs-lisp-mode
'("\\<with-tramp-dbus-get-all-properties\\>"))
-
(defvar tramp-gvfs-dbus-event-vector nil
"Current Tramp file name to be used, as vector.
It is needed when D-Bus signals or errors arrive, because there
@@ -966,6 +969,15 @@ The global value will always be nil; it is bound where
needed.")
;; File name primitives.
+(defun tramp-gvfs-info (filename &optional arg)
+ "Check FILENAME via `gvfs-info'.
+Set file property \"file-exists-p\" with the result."
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (tramp-set-file-property
+ v localname "file-exists-p"
+ (tramp-gvfs-send-command
+ v "gvfs-info" arg (tramp-gvfs-url-file-name filename)))))
+
(defun tramp-gvfs-do-copy-or-rename-file
(op filename newname &optional ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes)
@@ -983,6 +995,7 @@ This function is invoked by `tramp-gvfs-handle-copy-file'
and
`tramp-gvfs-handle-rename-file'. It is an error if OP is neither
of `copy' and `rename'. FILENAME and NEWNAME must be absolute
file names."
+ ;; FILENAME and NEWNAME are already expanded.
(unless (memq op '(copy rename))
(error "Unknown operation `%s', must be `copy' or `rename'" op))
@@ -1008,86 +1021,81 @@ file names."
(msg-operation (if (eq op 'copy) "Copying" "Renaming")))
(with-parsed-tramp-file-name (if t1 filename newname) nil
- (unless (file-exists-p filename)
- (tramp-compat-file-missing v filename))
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-error "File is a directory %s" newname))
-
- (cond
- ;; We cannot rename volatile files, as used by Google-drive.
- ((and (not equal-remote) volatile)
- (prog1 (copy-file
- filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes)
- (delete-file filename)))
-
- ;; We cannot copy or rename directly.
- ((or (and equal-remote
- (tramp-get-connection-property v "direct-copy-failed" nil))
- (and t1 (not (tramp-gvfs-file-name-p filename)))
- (and t2 (not (tramp-gvfs-file-name-p newname))))
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (if (eq op 'copy)
- (copy-file
- filename tmpfile t keep-date preserve-uid-gid
- preserve-extended-attributes)
- (rename-file filename tmpfile t))
- (rename-file tmpfile newname ok-if-already-exists)))
-
- ;; Direct action.
- (t (with-tramp-progress-reporter
- v 0 (format "%s %s to %s" msg-operation filename newname)
- (unless
- (and (apply
- #'tramp-gvfs-send-command v gvfs-operation
- (append
- (and (eq op 'copy) (or keep-date preserve-uid-gid)
- '("--preserve"))
- (list
- (tramp-gvfs-url-file-name filename)
- (tramp-gvfs-url-file-name newname))))
- ;; Some backends do not return a proper error
- ;; code in case of direct copy/move. Apply
- ;; sanity checks.
- (or (not equal-remote)
- (and
- (tramp-gvfs-send-command
- v "gvfs-info"
- (tramp-gvfs-url-file-name newname))
- (or (eq op 'copy)
- (not (tramp-gvfs-send-command
- v "gvfs-info"
- (tramp-gvfs-url-file-name filename)))))))
-
- (if (or (not equal-remote)
- (and equal-remote
- (tramp-get-connection-property
- v "direct-copy-failed" nil)))
- ;; Propagate the error.
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (tramp-error-with-buffer
- nil v 'file-error
- "%s failed, see buffer `%s' for details."
- msg-operation (buffer-name)))
-
- ;; Some WebDAV server, like the one from QNAP, do
- ;; not support direct copy/move. Try a fallback.
- (tramp-set-connection-property v "direct-copy-failed" t)
- (tramp-gvfs-do-copy-or-rename-file
- op filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes))))
-
- (when (and t1 (eq op 'rename))
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)))
-
- (when t2
- (with-parsed-tramp-file-name newname nil
- (tramp-flush-file-properties v localname)))))))))
+ (tramp-barf-if-file-missing v filename
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-error "File is a directory %s" newname))
+
+ (cond
+ ;; We cannot rename volatile files, as used by Google-drive.
+ ((and (not equal-remote) volatile)
+ (prog1 (copy-file
+ filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ (delete-file filename)))
+
+ ;; We cannot copy or rename directly.
+ ((or (and equal-remote
+ (tramp-get-connection-property v "direct-copy-failed"))
+ (and t1 (not (tramp-gvfs-file-name-p filename)))
+ (and t2 (not (tramp-gvfs-file-name-p newname))))
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
+ (if (eq op 'copy)
+ (copy-file
+ filename tmpfile t keep-date preserve-uid-gid
+ preserve-extended-attributes)
+ (rename-file filename tmpfile t))
+ (rename-file tmpfile newname ok-if-already-exists)))
+
+ ;; Direct action.
+ (t (with-tramp-progress-reporter
+ v 0 (format "%s %s to %s" msg-operation filename newname)
+ (unless
+ (and (apply
+ #'tramp-gvfs-send-command v gvfs-operation
+ (append
+ (and (eq op 'copy) (or keep-date preserve-uid-gid)
+ '("--preserve"))
+ (list
+ (tramp-gvfs-url-file-name filename)
+ (tramp-gvfs-url-file-name newname))))
+ ;; Some backends do not return a proper error
+ ;; code in case of direct copy/move. Apply
+ ;; sanity checks.
+ (or (not equal-remote)
+ (and
+ (tramp-gvfs-info newname)
+ (or (eq op 'copy)
+ (not (tramp-gvfs-info filename))))))
+
+ (if (or (not equal-remote)
+ (and equal-remote
+ (tramp-get-connection-property
+ v "direct-copy-failed")))
+ ;; Propagate the error.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (tramp-error-with-buffer
+ nil v 'file-error
+ "%s failed, see buffer `%s' for details."
+ msg-operation (buffer-name)))
+
+ ;; Some WebDAV server, like the one from QNAP, do
+ ;; not support direct copy/move. Try a fallback.
+ (tramp-set-connection-property v "direct-copy-failed" t)
+ (tramp-gvfs-do-copy-or-rename-file
+ op filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes))))
+
+ (when (and t1 (eq op 'rename))
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-properties v localname)))
+
+ (when t2
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-properties v localname))))))))))
(defun tramp-gvfs-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
@@ -1111,8 +1119,7 @@ file names."
(tramp-skeleton-delete-directory directory recursive trash
(if (and recursive (not (file-symlink-p directory)))
(mapc (lambda (file)
- (if (eq t (tramp-compat-file-attribute-type
- (file-attributes file)))
+ (if (eq t (file-attribute-type (file-attributes file)))
(delete-directory file recursive)
(delete-file file)))
(directory-files
@@ -1121,8 +1128,9 @@ file names."
(tramp-error
v 'file-error "Couldn't delete non-empty %s" directory)))
- (unless (tramp-gvfs-send-command
- v "gvfs-rm" (tramp-gvfs-url-file-name directory))
+ (unless (and (tramp-gvfs-send-command
+ v "gvfs-rm" (tramp-gvfs-url-file-name directory))
+ (not (tramp-gvfs-info directory)))
;; Propagate the error.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
@@ -1131,12 +1139,13 @@ file names."
(defun tramp-gvfs-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(tramp-flush-file-properties v localname)
(if (and delete-by-moving-to-trash trash)
(move-file-to-trash filename)
- (unless (tramp-gvfs-send-command
- v "gvfs-rm" (tramp-gvfs-url-file-name filename))
+ (unless (and (tramp-gvfs-send-command
+ v "gvfs-rm" (tramp-gvfs-url-file-name filename))
+ (not (tramp-gvfs-info filename)))
;; Propagate the error.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
@@ -1154,42 +1163,44 @@ file names."
(setq name (tramp-compat-file-name-concat dir name)))
;; If NAME is not a Tramp file, run the real handler.
(if (not (tramp-tramp-file-p name))
- (tramp-run-real-handler #'expand-file-name (list name nil))
+ (tramp-run-real-handler #'expand-file-name (list name))
;; Dissect NAME.
(with-parsed-tramp-file-name name nil
;; If there is a default location, expand tilde.
- (when (string-match "\\`\\(~\\)\\(/\\|\\'\\)" localname)
- (save-match-data
- (tramp-gvfs-maybe-open-connection
- (make-tramp-file-name
- :method method :user user :domain domain
- :host host :port port :localname "/" :hop hop)))
- (setq localname
- (replace-match
- (tramp-get-connection-property v "default-location" "~")
- nil t localname 1)))
+ (when (string-match
+ (tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl))
eos)
+ localname)
+ (let ((uname (match-string 1 localname))
+ (fname (match-string 2 localname))
+ hname)
+ (when (zerop (length uname))
+ (setq uname user))
+ (when (setq hname (tramp-get-home-directory v uname))
+ (setq localname (concat hname fname)))))
;; Tilde expansion is not possible.
(when (and (not tramp-tolerate-tilde)
- (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname))
+ (string-prefix-p "~" localname))
(tramp-error v 'file-error "Cannot expand tilde in file `%s'" name))
(unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
(setq localname (concat "/" localname)))
;; We do not pass "/..".
- (if (string-match-p "^\\(afp\\|davs?\\|smb\\)$" method)
- (when (string-match "^/[^/]+\\(/\\.\\./?\\)" localname)
+ (if (string-match-p (rx bos (| "afp" (: "dav" (? "s")) "smb") eos)
method)
+ (when (string-match
+ (tramp-compat-rx bos "/" (+ (not "/")) (group "/.." (? "/")))
+ localname)
(setq localname (replace-match "/" t t localname 1)))
- (when (string-match "^/\\.\\./?" localname)
+ (when (string-match (rx bol "/.." (? "/")) localname)
(setq localname (replace-match "/" t t localname))))
;; There might be a double slash. Remove this.
(while (string-match "//" localname)
(setq localname (replace-match "/" t t localname)))
;; Do not keep "/..".
- (when (string-match-p "^/\\.\\.?$" localname)
+ (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname)
(setq localname "/"))
- ;; No tilde characters in file name, do normal
- ;; `expand-file-name' (this does "/./" and "/../").
+ ;; Do normal `expand-file-name' (this does "/./" and "/../"),
+ ;; unless there are tilde characters in file name.
(tramp-make-tramp-file-name
- v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
+ v (if (string-prefix-p "~" localname)
localname
(tramp-run-real-handler #'expand-file-name (list localname)))))))
@@ -1198,7 +1209,7 @@ file names."
;; Don't modify `last-coding-system-used' by accident.
(let ((last-coding-system-used last-coding-system-used)
result)
- (with-parsed-tramp-file-name directory nil
+ (with-parsed-tramp-file-name (expand-file-name directory) nil
(with-tramp-file-property v localname "directory-attributes"
(tramp-message v 5 "directory gvfs attributes: %s" localname)
;; Send command.
@@ -1211,20 +1222,22 @@ file names."
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(while (looking-at
- (eval-when-compile
- (concat "^\\(.+\\)[[:blank:]]"
- "\\([[:digit:]]+\\)[[:blank:]]"
- "(\\(.+?\\))"
- tramp-gvfs-file-attributes-with-gvfs-ls-regexp)))
+ (tramp-compat-rx
+ bol (group (+ nonl)) blank
+ (group (+ digit)) blank
+ "(" (group (+? nonl)) ")"
+ (regexp tramp-gvfs-file-attributes-with-gvfs-ls-regexp)))
(let ((item (list (cons "type" (match-string 3))
(cons "standard::size" (match-string 2))
(cons "name" (match-string 1)))))
(goto-char (1+ (match-end 3)))
(while (looking-at
- (concat
- tramp-gvfs-file-attributes-with-gvfs-ls-regexp
- "\\(" tramp-gvfs-file-attributes-with-gvfs-ls-regexp
- "\\|" "$" "\\)"))
+ (tramp-compat-rx
+ (regexp tramp-gvfs-file-attributes-with-gvfs-ls-regexp)
+ (group
+ (| (regexp
+ tramp-gvfs-file-attributes-with-gvfs-ls-regexp)
+ eol))))
(push (cons (match-string 1) (match-string 2)) item)
(goto-char (match-end 2)))
;; Add display name as head.
@@ -1242,7 +1255,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
;; Don't modify `last-coding-system-used' by accident.
(let ((last-coding-system-used last-coding-system-used)
result)
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property
v localname
(if file-system "file-system-attributes" "file-attributes")
@@ -1251,10 +1264,8 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
(if file-system " system" "") localname)
;; Send command.
(if file-system
- (tramp-gvfs-send-command
- v "gvfs-info" "--filesystem" (tramp-gvfs-url-file-name filename))
- (tramp-gvfs-send-command
- v "gvfs-info" (tramp-gvfs-url-file-name filename)))
+ (tramp-gvfs-info filename "--filesystem")
+ (tramp-gvfs-info filename))
;; Parse output.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
@@ -1271,8 +1282,10 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
(setq filename (directory-file-name (expand-file-name filename)))
(with-parsed-tramp-file-name filename nil
(setq localname (tramp-compat-file-name-unquote localname))
- (if (or (and (string-match-p "^\\(afp\\|davs?\\|smb\\)$" method)
- (string-match-p "^/?\\([^/]+\\)$" localname))
+ (if (or (and (string-match-p
+ (rx bol (| "afp" (: "dav" (? "s")) "smb") eol) method)
+ (string-match-p
+ (tramp-compat-rx bol (? "/") (+ (not "/")) eol) localname))
(string-equal localname "/"))
(tramp-gvfs-get-root-attributes filename)
(assoc
@@ -1302,7 +1315,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
;; Convert them to multibyte.
(decode-coding-string
(replace-regexp-in-string
- "\\\\x\\([[:xdigit:]]\\{2\\}\\)"
+ (rx "\\x" (group (= 2 xdigit)))
(lambda (x)
(unibyte-string (string-to-number (match-string 1 x) 16)))
res-symlink-target)
@@ -1316,7 +1329,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(if (eq id-format 'integer)
(string-to-number
(or (cdr (assoc "unix::uid" attributes))
- (eval-when-compile (format "%s"
tramp-unknown-id-integer))))
+ (number-to-string tramp-unknown-id-integer)))
(or (cdr (assoc "owner::user" attributes))
(cdr (assoc "unix::uid" attributes))
tramp-unknown-id-string)))
@@ -1324,7 +1337,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(if (eq id-format 'integer)
(string-to-number
(or (cdr (assoc "unix::gid" attributes))
- (eval-when-compile (format "%s"
tramp-unknown-id-integer))))
+ (number-to-string tramp-unknown-id-integer)))
(or (cdr (assoc "owner::group" attributes))
(cdr (assoc "unix::gid" attributes))
tramp-unknown-id-string)))
@@ -1347,32 +1360,29 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
(or (cdr (assoc "standard::size" attributes)) "0")))
;; ... file mode flags
(setq res-filemodes
- (let ((n (cdr (assoc "unix::mode" attributes))))
- (if n
- (tramp-file-mode-from-int (string-to-number n))
- (format
- "%s%s%s%s------"
- (if dirp "d" (if res-symlink-target "l" "-"))
- (if (equal (cdr (assoc "access::can-read" attributes))
- "FALSE")
- "-" "r")
- (if (equal (cdr (assoc "access::can-write" attributes))
- "FALSE")
- "-" "w")
- (if (equal (cdr (assoc "access::can-execute" attributes))
- "FALSE")
- "-" "x")))))
+ (if-let ((n (cdr (assoc "unix::mode" attributes))))
+ (tramp-file-mode-from-int (string-to-number n))
+ (format
+ "%s%s%s%s------"
+ (if dirp "d" (if res-symlink-target "l" "-"))
+ (if (equal (cdr (assoc "access::can-read" attributes))
+ "FALSE")
+ "-" "r")
+ (if (equal (cdr (assoc "access::can-write" attributes))
+ "FALSE")
+ "-" "w")
+ (if (equal (cdr (assoc "access::can-execute" attributes))
+ "FALSE")
+ "-" "x"))))
;; ... inode and device
(setq res-inode
- (let ((n (cdr (assoc "unix::inode" attributes))))
- (if n
- (string-to-number n)
- (tramp-get-inode (tramp-dissect-file-name filename)))))
+ (if-let ((n (cdr (assoc "unix::inode" attributes))))
+ (string-to-number n)
+ (tramp-get-inode (tramp-dissect-file-name filename))))
(setq res-device
- (let ((n (cdr (assoc "unix::device" attributes))))
- (if n
- (string-to-number n)
- (tramp-get-device (tramp-dissect-file-name filename)))))
+ (if-let ((n (cdr (assoc "unix::device" attributes))))
+ (string-to-number n)
+ (tramp-get-device (tramp-dissect-file-name filename))))
;; Return data gathered.
(list
@@ -1404,7 +1414,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(defun tramp-gvfs-handle-file-executable-p (filename)
"Like `file-executable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-executable-p"
(or (tramp-check-cached-permissions v ?x)
(tramp-check-cached-permissions v ?s)))))
@@ -1474,8 +1484,8 @@ If FILE-SYSTEM is non-nil, return file system attributes."
`file-notify' events."
(let* ((events (process-get proc 'events))
(rest-string (process-get proc 'rest-string))
- (dd (with-current-buffer (process-buffer proc) default-directory))
- (ddu (regexp-quote (tramp-gvfs-url-file-name dd))))
+ (dd (tramp-get-default-directory (process-buffer proc)))
+ (ddu (tramp-compat-rx (literal (tramp-gvfs-url-file-name dd)))))
(when rest-string
(tramp-message proc 10 "Previous string:\n%s" rest-string))
(tramp-message proc 6 "%S\n%s" proc string)
@@ -1489,15 +1499,16 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
"renamed to" "moved" string))
;; https://bugs.launchpad.net/bugs/1742946
(when
- (string-match-p "Monitoring not supported\\|No locations given" string)
+ (string-match-p
+ (rx (| "Monitoring not supported" "No locations given")) string)
(delete-process proc))
(while (string-match
- (eval-when-compile
- (concat "^.+:"
- "[[:space:]]\\(.+\\):"
- "[[:space:]]" (regexp-opt tramp-gio-events t)
- "\\([[:space:]]\\(.+\\)\\)?$"))
+ (tramp-compat-rx
+ bol (+ nonl) ":"
+ blank (group (+ nonl)) ":"
+ blank (group (regexp (regexp-opt tramp-gio-events)))
+ (? (group blank (group (+ nonl)))) eol)
string)
(let ((file (match-string 1 string))
@@ -1507,11 +1518,11 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
;; File names are returned as URL paths. We must convert them.
(when (string-match ddu file)
(setq file (replace-match dd nil nil file)))
- (while (string-match-p "%\\([[:xdigit:]]\\{2\\}\\)" file)
+ (while (string-match-p (rx "%" (= 2 xdigit)) file)
(setq file (url-unhex-string file)))
(when (string-match ddu (or file1 ""))
(setq file1 (replace-match dd nil nil file1)))
- (while (string-match-p "%\\([[:xdigit:]]\\{2\\}\\)" (or file1 ""))
+ (while (string-match-p (rx "%" (= 2 xdigit)) (or file1 ""))
(setq file1 (url-unhex-string file1)))
;; Remove watch when file or directory to be watched is deleted.
(when (and (member action '(moved deleted))
@@ -1539,11 +1550,13 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
(size (cdr (assoc "filesystem::size" attr)))
(used (cdr (assoc "filesystem::used" attr)))
(free (cdr (assoc "filesystem::free" attr))))
- (when (or size used free)
- (list (string-to-number (or size "0"))
- (string-to-number (or free "0"))
- (- (string-to-number (or size "0"))
- (string-to-number (or used "0"))))))))
+ (when (or size free)
+ (list (and size (string-to-number size))
+ (and free (string-to-number free))
+ ;; "mtp" connections do not return "filesystem::used".
+ (or (and size used
+ (- (string-to-number size) (string-to-number used)))
+ (and free (string-to-number free))))))))
(defun tramp-gvfs-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
@@ -1560,8 +1573,10 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
(make-directory ldir parents))
;; Just do it.
(or (when-let ((mkdir-succeeded
- (tramp-gvfs-send-command
- v "gvfs-mkdir" (tramp-gvfs-url-file-name dir))))
+ (and
+ (tramp-gvfs-send-command
+ v "gvfs-mkdir" (tramp-gvfs-url-file-name dir))
+ (tramp-gvfs-info dir))))
(set-file-modes dir (default-file-modes))
mkdir-succeeded)
(and parents (file-directory-p dir))
@@ -1591,21 +1606,18 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
(with-current-buffer (tramp-get-connection-buffer vec)
(goto-char (point-min))
(when (looking-at-p "gio: Operation not supported")
- (tramp-set-connection-property vec key nil)))
- nil))))
+ (tramp-set-connection-property vec key nil)))))))
(defun tramp-gvfs-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(tramp-gvfs-set-attribute
v (if (eq flag 'nofollow) "-nt" "-t") "uint32"
(tramp-gvfs-url-file-name filename) "unix::mode" (number-to-string
mode))))
(defun tramp-gvfs-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(tramp-gvfs-set-attribute
v (if (eq flag 'nofollow) "-nt" "-t") "uint64"
(tramp-gvfs-url-file-name filename) "time::modified"
@@ -1613,33 +1625,52 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
"%s" (if (or (null time)
(tramp-compat-time-equal-p time tramp-time-doesnt-exist)
(tramp-compat-time-equal-p time tramp-time-dont-know))
- (current-time)
+ nil
time)))))
+(defun tramp-gvfs-handle-get-home-directory (vec &optional _user)
+ "The remote home directory for connection VEC as local file name.
+If USER is a string, return its home directory instead of the
+user identified by VEC. If there is no user specified in either
+VEC or USER, or if there is no home directory, return nil."
+ (let ((localname (tramp-get-connection-property vec "default-location"))
+ result)
+ (cond
+ ((zerop (length localname))
+ (tramp-get-connection-property (tramp-get-process vec) "share"))
+ ;; Google-drive.
+ ((not (string-prefix-p "/" localname))
+ (dolist (item
+ (tramp-gvfs-get-directory-attributes
+ (tramp-make-tramp-file-name vec "/"))
+ result)
+ (when (string-equal (cdr (assoc "name" item)) localname)
+ (setq result (concat "/" (car item))))))
+ (t localname))))
+
(defun tramp-gvfs-handle-get-remote-uid (vec id-format)
"The uid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
+ ;; The result is cached in `tramp-get-remote-uid'.
(if (equal id-format 'string)
(tramp-file-name-user vec)
(when-let ((localname
- (tramp-get-connection-property
- (tramp-get-process vec) "share" nil)))
- (tramp-compat-file-attribute-user-id
+ (tramp-get-connection-property (tramp-get-process vec)
"share")))
+ (file-attribute-user-id
(file-attributes (tramp-make-tramp-file-name vec localname)
id-format)))))
(defun tramp-gvfs-handle-get-remote-gid (vec id-format)
"The gid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
+ ;; The result is cached in `tramp-get-remote-gid'.
(when-let ((localname
- (tramp-get-connection-property
- (tramp-get-process vec) "share" nil)))
- (tramp-compat-file-attribute-group-id
+ (tramp-get-connection-property (tramp-get-process vec) "share")))
+ (file-attribute-group-id
(file-attributes (tramp-make-tramp-file-name vec localname) id-format))))
(defun tramp-gvfs-handle-set-file-uid-gid (filename &optional uid gid)
"Like `tramp-set-file-uid-gid' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(when (natnump uid)
(tramp-gvfs-set-attribute
v "-t" "uint32"
@@ -1670,7 +1701,7 @@ ID-FORMAT valid values are `string' and `integer'."
(concat (tramp-gvfs-get-remote-prefix v) localname)))
(when (string-equal "mtp" method)
(when-let
- ((media (tramp-get-connection-property v "media-device" nil)))
+ ((media (tramp-get-connection-property v "media-device")))
(setq method (tramp-media-device-method media)
host (tramp-media-device-host media)
port (tramp-media-device-port media))))
@@ -1707,14 +1738,16 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-gvfs-file-name (object-path)
"Retrieve file name from D-Bus OBJECT-PATH."
(dbus-unescape-from-identifier
- (replace-regexp-in-string "^.*/\\([^/]+\\)$" "\\1" object-path)))
+ (replace-regexp-in-string
+ (tramp-compat-rx bol (* nonl) "/" (group (+ (not "/"))) eol) "\\1"
+ object-path)))
(defun tramp-gvfs-url-host (url)
"Return the host name part of URL, a string.
We cannot use `url-host', because `url-generic-parse-url' returns
a downcased host name only."
(and (stringp url)
- (string-match "^[[:alnum:]]+://\\([^/:]+\\)" url)
+ (string-match (rx bol (+ alnum) "://" (group (+ (not (any "/:"))))) url)
(match-string 1 url)))
@@ -1727,7 +1760,8 @@ a downcased host name only."
(pw-prompt
(format
"%s for %s "
- (if (string-match "\\([pP]assword\\|[pP]assphrase\\)" message)
+ (if (string-match
+ (rx (group (any "Pp") (| "assword" "assphrase"))) message)
(capitalize (match-string 1 message))
"Password")
filename))
@@ -1745,7 +1779,7 @@ a downcased host name only."
(setq domain (read-string "Domain name: ")))
(tramp-message l 6 "%S %S %S %d" message user domain flags)
- (unless (tramp-get-connection-property l "first-password-request" nil)
+ (unless (tramp-get-connection-property l "first-password-request")
(tramp-clear-passwd l))
(setq password (tramp-read-passwd
@@ -1790,7 +1824,8 @@ a downcased host name only."
(progn
(message "%s" message)
0)
- (with-tramp-connection-property (tramp-get-process v)
message
+ (with-tramp-connection-property
+ (tramp-get-process v) message
;; In theory, there can be several choices.
;; Until now, there is only the question
;; whether to accept an unknown host
@@ -1848,7 +1883,7 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\"
and
(cadr (assoc "ssl" (cadr mount-spec)))))
(uri (tramp-gvfs-dbus-byte-array-to-string
(cadr (assoc "uri" (cadr mount-spec))))))
- (when (string-match "^\\(afp\\|smb\\)" method)
+ (when (string-match (rx bol (group (| "afp" "smb"))) method)
(setq method (match-string 1 method)))
(when (and (string-equal "dav" method) (string-equal "true" ssl))
(setq method "davs"))
@@ -1867,23 +1902,22 @@ Their full names are
\"org.gtk.vfs.MountTracker.mounted\" and
(when (member method tramp-media-methods)
;; Ensure that media devices are cached.
(tramp-get-media-devices nil)
- (let ((v (tramp-get-connection-property
- (make-tramp-media-device
- :method method :host host :port port)
- "vector" nil)))
- (when v
- (setq method (tramp-file-name-method v)
- host (tramp-file-name-host v)
- port (tramp-file-name-port v)))))
+ (when-let ((v (tramp-get-connection-property
+ (make-tramp-media-device
+ :method method :host host :port port)
+ "vector" nil)))
+ (setq method (tramp-file-name-method v)
+ host (tramp-file-name-host v)
+ port (tramp-file-name-port v))))
(when (member method tramp-gvfs-methods)
- (let ((v (make-tramp-file-name
- :method method :user user :domain domain
- :host host :port port)))
+ (let ((v (make-tramp-file-name
+ :method method :user user :domain domain
+ :host host :port port)))
(tramp-message
v 6 "%s %s"
signal-name (tramp-gvfs-stringify-dbus-message mount-info))
(tramp-flush-file-property v "/" "list-mounts")
- (if (string-equal (downcase signal-name) "unmounted")
+ (if (tramp-compat-string-equal-ignore-case signal-name "unmounted")
(tramp-flush-file-properties v "/")
;; Set mountpoint and location.
(tramp-set-file-property v "/" "fuse-mountpoint" fuse-mountpoint)
@@ -1912,15 +1946,14 @@ Their full names are
\"org.gtk.vfs.MountTracker.mounted\" and
(defun tramp-gvfs-connection-mounted-p (vec)
"Check, whether the location is already mounted."
(or
- (tramp-get-file-property vec "/" "fuse-mountpoint" nil)
+ (tramp-get-file-property vec "/" "fuse-mountpoint")
(catch 'mounted
(dolist
(elt
(with-tramp-file-property vec "/" "list-mounts"
(with-tramp-dbus-call-method vec t
:session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
- tramp-gvfs-interface-mounttracker tramp-gvfs-listmounts))
- nil)
+ tramp-gvfs-interface-mounttracker tramp-gvfs-listmounts)))
;; Jump over the first elements of the mount info. Since there
;; were changes in the entries, we cannot access dedicated
;; elements.
@@ -1950,7 +1983,7 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\"
and
(or
(cadr (assoc "share" (cadr mount-spec)))
(cadr (assoc "volume" (cadr mount-spec)))))))
- (when (string-match "^\\(afp\\|smb\\)" method)
+ (when (string-match (rx bol (group (| "afp" "smb"))) method)
(setq method (match-string 1 method)))
(when (and (string-equal "dav" method) (string-equal "true" ssl))
(setq method "davs"))
@@ -1969,22 +2002,22 @@ Their full names are
\"org.gtk.vfs.MountTracker.mounted\" and
(when (member method tramp-media-methods)
;; Ensure that media devices are cached.
(tramp-get-media-devices vec)
- (let ((v (tramp-get-connection-property
- (make-tramp-media-device
- :method method :host host :port port)
- "vector" nil)))
- (when v
- (setq method (tramp-file-name-method v)
- host (tramp-file-name-host v)
- port (tramp-file-name-port v)))))
+ (when-let ((v (tramp-get-connection-property
+ (make-tramp-media-device
+ :method method :host host :port port)
+ "vector")))
+ (setq method (tramp-file-name-method v)
+ host (tramp-file-name-host v)
+ port (tramp-file-name-port v))))
(when (and
(string-equal method (tramp-file-name-method vec))
(string-equal user (tramp-file-name-user vec))
(string-equal domain (tramp-file-name-domain vec))
(string-equal host (tramp-file-name-host vec))
(string-equal port (tramp-file-name-port vec))
- (string-match-p (concat "^/" (regexp-quote (or share "")))
- (tramp-file-name-unquote-localname vec)))
+ (string-match-p
+ (tramp-compat-rx bol "/" (literal (or share "")))
+ (tramp-file-name-unquote-localname vec)))
;; Set mountpoint and location.
(tramp-set-file-property vec "/" "fuse-mountpoint" fuse-mountpoint)
(tramp-set-connection-property
@@ -2009,7 +2042,7 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\"
and
(defun tramp-gvfs-mount-spec-entry (key value)
"Construct a mount-spec entry to be used in a mount_spec.
It was \"a(say)\", but has changed to \"a{sv})\"."
- (if (string-match-p "^(aya{sv})" tramp-gvfs-mountlocation-signature)
+ (if (string-match-p (rx bol "(aya{sv})") tramp-gvfs-mountlocation-signature)
(list :dict-entry key
(list :variant (tramp-gvfs-dbus-string-to-byte-array value)))
(list :struct key (tramp-gvfs-dbus-string-to-byte-array value))))
@@ -2027,9 +2060,12 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
(port (if media
(tramp-media-device-port media) (tramp-file-name-port vec)))
(localname (tramp-file-name-unquote-localname vec))
- (share (when (string-match "^/?\\([^/]+\\)" localname)
+ (share (when (string-match
+ (tramp-compat-rx bol (? "/") (group (+ (not "/"))))
+ localname)
(match-string 1 localname)))
- (ssl (if (string-match-p "^davs\\|^nextcloud" method) "true" "false"))
+ (ssl (if (string-match-p (rx bol (| "davs" "nextcloud")) method)
+ "true" "false"))
(mount-spec
`(:array
,@(cond
@@ -2037,7 +2073,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
(list (tramp-gvfs-mount-spec-entry "type" "smb-share")
(tramp-gvfs-mount-spec-entry "server" host)
(tramp-gvfs-mount-spec-entry "share" share)))
- ((string-match-p "^dav\\|^nextcloud" method)
+ ((string-match-p (rx bol (| "davs" "nextcloud")) method)
(list (tramp-gvfs-mount-spec-entry "type" "dav")
(tramp-gvfs-mount-spec-entry "host" host)
(tramp-gvfs-mount-spec-entry "ssl" ssl)))
@@ -2051,7 +2087,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
((string-equal "nextcloud" method)
(list (tramp-gvfs-mount-spec-entry "type" "owncloud")
(tramp-gvfs-mount-spec-entry "host" host)))
- ((string-match-p "^http" method)
+ ((string-match-p (rx bol "http") method)
(list (tramp-gvfs-mount-spec-entry "type" "http")
(tramp-gvfs-mount-spec-entry
"uri"
@@ -2068,8 +2104,9 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
,@(when port
(list (tramp-gvfs-mount-spec-entry "port" port)))))
(mount-pref
- (if (and (string-match-p "^dav" method)
- (string-match "^/?[^/]+" localname))
+ (if (and (string-match-p (rx bol "dav") method)
+ (string-match
+ (tramp-compat-rx bol (? "/") (+ (not "/"))) localname))
(match-string 0 localname)
(tramp-gvfs-get-remote-prefix vec))))
@@ -2156,7 +2193,7 @@ connection if a previous connection has died for some
reason."
(string-equal localname "/"))
(tramp-user-error vec "Filename must contain an AFP volume"))
- (when (and (string-match-p "davs?" method)
+ (when (and (string-match-p (rx "dav" (? "s")) method)
(string-equal localname "/"))
(tramp-user-error vec "Filename must contain a WebDAV share"))
@@ -2206,7 +2243,7 @@ connection if a previous connection has died for some
reason."
;; The call must be asynchronously, because of the "askPassword"
;; or "askQuestion" callbacks.
- (if (string-match-p "(so)$" tramp-gvfs-mountlocation-signature)
+ (if (string-match-p (rx "(so)" eol) tramp-gvfs-mountlocation-signature)
(with-tramp-dbus-call-method vec nil
:session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation
@@ -2232,7 +2269,7 @@ connection if a previous connection has died for some
reason."
(tramp-error
vec 'file-error
"Timeout reached mounting %s@%s using %s" user host method)))
- (while (not (tramp-get-file-property vec "/" "fuse-mountpoint" nil))
+ (while (not (tramp-get-file-property vec "/" "fuse-mountpoint"))
(read-event nil nil 0.1)))
;; If `tramp-gvfs-handler-askquestion' has returned "No", it
@@ -2370,11 +2407,11 @@ It checks for registered GNOME Online Accounts."
(defun tramp-get-media-device (vec)
"Transform VEC into a `tramp-media-device' structure.
Check, that respective cache values do exist."
- (if-let ((media (tramp-get-connection-property vec "media-device" nil))
- (prop (tramp-get-connection-property media "vector" nil)))
+ (if-let ((media (tramp-get-connection-property vec "media-device"))
+ (prop (tramp-get-connection-property media "vector")))
media
(tramp-get-media-devices vec)
- (tramp-get-connection-property vec "media-device" nil)))
+ (tramp-get-connection-property vec "media-device")))
(defun tramp-get-media-devices (vec)
"Retrieve media devices, and cache them.
@@ -2419,9 +2456,9 @@ It checks for mounted media devices."
(lambda (key)
(and (tramp-media-device-p key)
(string-equal service (tramp-media-device-method key))
- (tramp-get-connection-property key "vector" nil)
+ (tramp-get-connection-property key "vector")
(list nil (tramp-file-name-host
- (tramp-get-connection-property key "vector" nil)))))
+ (tramp-get-connection-property key "vector")))))
(hash-table-keys tramp-cache-data)))
@@ -2436,7 +2473,7 @@ It checks for mounted media devices."
(text (zeroconf-service-txt x))
user)
(when port
- (setq host (format "%s%s%d" host tramp-prefix-port-regexp port)))
+ (setq host (format "%s%s%d" host tramp-prefix-port-format port)))
;; A user is marked in a TXT field like "u=guest".
(while text
(when (string-match "u=\\(.+\\)$" (car text))
@@ -2452,7 +2489,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled
in Avahi."
(ignore-errors
(split-string
(shell-command-to-string (format "avahi-browse -trkp %s" service))
- "[\n\r]+" 'omit "^\\+;.*$"))))
+ (rx (+ (any "\r\n"))) 'omit (rx bol "+;" (* nonl) eol)))))
(delete-dups
(mapcar
(lambda (x)
@@ -2462,13 +2499,14 @@ This uses \"avahi-browse\" in case D-Bus is not enabled
in Avahi."
user)
;; A user is marked in a TXT field like "u=guest".
(while text
- (when (string-match "u=\\(.+\\)$" (car text))
+ (when (string-match (rx "u=" (group (+ nonl)) eol) (car text))
(setq user (match-string 1 (car text))))
(setq text (cdr text)))
(list user host)))
result))))
(when tramp-gvfs-enabled
+ (with-no-warnings ;; max-specpdl-size
;; Suppress D-Bus error messages and Tramp traces.
(let (;; Sometimes, it fails with "Variable binding depth exceeds
;; max-specpdl-size". Shall be fixed in Emacs 27.
@@ -2526,7 +2564,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled
in Avahi."
"mtp"
(mapcar
(lambda (method) `(tramp-parse-media-names ,(format "_%s._tcp" method)))
- tramp-media-methods))))
+ tramp-media-methods)))))
(add-hook 'tramp-unload-hook
(lambda ()
diff --git a/tramp-integration.el b/tramp-integration.el
index 9aa4b2b1e8..78107e1a03 100644
--- a/tramp-integration.el
+++ b/tramp-integration.el
@@ -39,6 +39,7 @@
(declare-function info-lookup->topic-value "info-look")
(declare-function info-lookup-maybe-add-help "info-look")
(declare-function recentf-cleanup "recentf")
+(declare-function shortdoc-add-function "shortdoc")
(declare-function tramp-dissect-file-name "tramp")
(declare-function tramp-file-name-equal-p "tramp")
(declare-function tramp-tramp-file-p "tramp")
@@ -49,6 +50,7 @@
(defvar info-lookup-alist)
(defvar ivy-completing-read-handlers-alist)
(defvar recentf-exclude)
+(defvar shortdoc--groups)
(defvar tramp-current-connection)
(defvar tramp-postfix-host-format)
(defvar tramp-use-ssh-controlmaster-options)
@@ -83,14 +85,8 @@ special handling of `substitute-in-file-name'."
(defun tramp-rfn-eshadow-update-overlay-regexp ()
"An overlay covering the shadowed part of the filename."
- (format "[^%s/~]*\\(/\\|~\\)" tramp-postfix-host-format))
-
-;; Package rfn-eshadow is preloaded in Emacs, but for some reason,
-;; it only did (defvar rfn-eshadow-overlay) without giving it a global
-;; value, so it was only declared as dynamically-scoped within the
-;; rfn-eshadow.el file. This is now fixed in Emacs>26.1 but we still need
-;; this defvar here for older releases.
-(defvar rfn-eshadow-overlay)
+ (rx-to-string
+ `(: (* (not (any ,tramp-postfix-host-format "/~"))) (| "/" "~"))))
(defun tramp-rfn-eshadow-update-overlay ()
"Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input.
@@ -113,7 +109,7 @@ been set up by `rfn-eshadow-setup-minibuffer'."
end))
(point-max))
(let ((rfn-eshadow-overlay tramp-rfn-eshadow-overlay)
- (rfn-eshadow-update-overlay-hook nil)
+ rfn-eshadow-update-overlay-hook
file-name-handler-alist)
(move-overlay rfn-eshadow-overlay (point-max) (point-max))
(rfn-eshadow-update-overlay))))))))
@@ -129,6 +125,8 @@ been set up by `rfn-eshadow-setup-minibuffer'."
;; eshell.el keeps the path in `eshell-path-env'. We must change it
;; when `default-directory' points to another host.
+;; This is fixed in Eshell with Emacs 29.1.
+
(defun tramp-eshell-directory-change ()
"Set `eshell-path-env' to $PATH of the host related to `default-directory'."
;; Remove last element of `(exec-path)', which is `exec-directory'.
@@ -140,16 +138,17 @@ been set up by `rfn-eshadow-setup-minibuffer'."
(getenv "PATH"))))
(with-eval-after-load 'esh-util
- (add-hook 'eshell-mode-hook
- #'tramp-eshell-directory-change)
- (add-hook 'eshell-directory-change-hook
- #'tramp-eshell-directory-change)
- (add-hook 'tramp-integration-unload-hook
- (lambda ()
- (remove-hook 'eshell-mode-hook
- #'tramp-eshell-directory-change)
- (remove-hook 'eshell-directory-change-hook
- #'tramp-eshell-directory-change))))
+ (unless (boundp 'eshell-path-env-list)
+ (add-hook 'eshell-mode-hook
+ #'tramp-eshell-directory-change)
+ (add-hook 'eshell-directory-change-hook
+ #'tramp-eshell-directory-change)
+ (add-hook 'tramp-integration-unload-hook
+ (lambda ()
+ (remove-hook 'eshell-mode-hook
+ #'tramp-eshell-directory-change)
+ (remove-hook 'eshell-directory-change-hook
+ #'tramp-eshell-directory-change)))))
;;; Integration of recentf.el:
@@ -222,9 +221,13 @@ NAME must be equal to `tramp-current-connection'."
;; Create a pseudo mode `tramp-info-lookup-mode' for Tramp symbol lookup.
(info-lookup-maybe-add-help
:mode 'tramp-info-lookup-mode :topic 'symbol
- :regexp "[^][()`'‘’,\" \t\n]+"
- :doc-spec '(("(tramp)Function Index" nil "^ -+ .*: " "\\( \\|$\\)")
- ("(tramp)Variable Index" nil "^ -+ .*: " "\\( \\|$\\)")))
+ :regexp (rx (+ (not (any "\t\n \"'(),[]`‘’"))))
+ :doc-spec `(("(tramp)Function Index" nil
+ ,(rx bol blank (+ "-") blank (* nonl) ":" blank)
+ ,(rx (| blank eol)))
+ ("(tramp)Variable Index" nil
+ ,(rx bol blank (+ "-") blank (* nonl) ":" blank)
+ ,(rx (| blank eol)))))
(add-hook
'tramp-integration-unload-hook
@@ -266,6 +269,33 @@ NAME must be equal to `tramp-current-connection'."
(delete (info-lookup->mode-cache 'symbol ',mode)
(info-lookup->topic-cache 'symbol))))))))
+;;; Integration of shortdoc.el:
+
+(with-eval-after-load 'shortdoc
+ (dolist (elem '((file-remote-p
+ :eval (file-remote-p "/ssh:user@host:/tmp/foo")
+ :eval (file-remote-p "/ssh:user@host:/tmp/foo" 'method))
+ (file-local-name
+ :eval (file-local-name "/ssh:user@host:/tmp/foo"))
+ (file-local-copy
+ :no-eval (file-local-copy "/ssh:user@host:/tmp/foo")
+ :eg-result "/tmp/tramp.8ihLbO"
+ :eval (file-local-copy "/tmp/foo"))))
+ (unless (assoc (car elem)
+ (member "Remote Files" (assq 'file shortdoc--groups)))
+ (shortdoc-add-function 'file "Remote Files" elem)))
+
+ (add-hook
+ 'tramp-integration-unload-hook
+ (lambda ()
+ (let ((glist (assq 'file shortdoc--groups)))
+ (while (and (consp glist)
+ (not (and (stringp (cadr glist))
+ (string-equal (cadr glist) "Remote Files"))))
+ (setq glist (cdr glist)))
+ (when (consp glist)
+ (setcdr glist nil))))))
+
;;; Integration of compile.el:
;; Compilation processes use `accept-process-output' such a way that
@@ -280,25 +310,21 @@ NAME must be equal to `tramp-current-connection'."
#'tramp-compile-disable-ssh-controlmaster-options)
(add-hook 'tramp-integration-unload-hook
(lambda ()
- (remove-hook 'compilation-start-hook
+ (remove-hook 'compilation-mode-hook
#'tramp-compile-disable-ssh-controlmaster-options))))
-;;; Default connection-local variables for Tramp:
-;; `connection-local-set-profile-variables' and
-;; `connection-local-set-profiles' exists since Emacs 26.1.
+;;; Default connection-local variables for Tramp.
(defconst tramp-connection-local-default-system-variables
'((path-separator . ":")
(null-device . "/dev/null"))
"Default connection-local system variables for remote connections.")
-(tramp-compat-funcall
- 'connection-local-set-profile-variables
+(connection-local-set-profile-variables
'tramp-connection-local-default-system-profile
tramp-connection-local-default-system-variables)
-(tramp-compat-funcall
- 'connection-local-set-profiles
+(connection-local-set-profiles
'(:application tramp)
'tramp-connection-local-default-system-profile)
@@ -307,17 +333,229 @@ NAME must be equal to `tramp-current-connection'."
(shell-command-switch . "-c"))
"Default connection-local shell variables for remote connections.")
-(tramp-compat-funcall
- 'connection-local-set-profile-variables
+(connection-local-set-profile-variables
'tramp-connection-local-default-shell-profile
tramp-connection-local-default-shell-variables)
(with-eval-after-load 'shell
- (tramp-compat-funcall
- 'connection-local-set-profiles
+ (connection-local-set-profiles
'(:application tramp)
'tramp-connection-local-default-shell-profile))
+;; Tested with FreeBSD 12.2.
+(defconst tramp-bsd-process-attributes-ps-args
+ `("-acxww"
+ "-o"
+ ,(mapconcat
+ #'identity
+ '("pid"
+ "euid"
+ "user"
+ "egid"
+ "egroup"
+ "comm=abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ")
+ ",")
+ "-o"
+ ,(mapconcat
+ #'identity
+ '("state"
+ "ppid"
+ "pgid"
+ "sid"
+ "tty"
+ "tpgid"
+ "minflt"
+ "majflt"
+ "time"
+ "pri"
+ "nice"
+ "vsz"
+ "rss"
+ "etimes"
+ "pcpu"
+ "pmem"
+ "args")
+ ","))
+ "List of arguments for \"ps\".
+See `tramp-process-attributes-ps-args'.")
+
+(defconst tramp-bsd-process-attributes-ps-format
+ '((pid . number)
+ (euid . number)
+ (user . string)
+ (egid . number)
+ (group . string)
+ (comm . 52)
+ (state . string)
+ (ppid . number)
+ (pgrp . number)
+ (sess . number)
+ (ttname . string)
+ (tpgid . number)
+ (minflt . number)
+ (majflt . number)
+ (time . tramp-ps-time)
+ (pri . number)
+ (nice . number)
+ (vsize . number)
+ (rss . number)
+ (etime . number)
+ (pcpu . number)
+ (pmem . number)
+ (args . nil))
+ "Alist of formats for \"ps\".
+See `tramp-process-attributes-ps-format'.")
+
+(defconst tramp-connection-local-bsd-ps-variables
+ `((tramp-process-attributes-ps-args
+ . ,tramp-bsd-process-attributes-ps-args)
+ (tramp-process-attributes-ps-format
+ . ,tramp-bsd-process-attributes-ps-format))
+ "Default connection-local ps variables for remote BSD connections.")
+
+(connection-local-set-profile-variables
+ 'tramp-connection-local-bsd-ps-profile
+ tramp-connection-local-bsd-ps-variables)
+
+;; Tested with BusyBox v1.24.1.
+(defconst tramp-busybox-process-attributes-ps-args
+ `("-o"
+ ,(mapconcat
+ #'identity
+ '("pid"
+ "user"
+ "group"
+ "comm=abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ")
+ ",")
+ "-o" "stat=abcde"
+ "-o"
+ ,(mapconcat
+ #'identity
+ '("ppid"
+ "pgid"
+ "tty"
+ "time"
+ "nice"
+ "etime"
+ "args")
+ ","))
+ "List of arguments for \"ps\".
+See `tramp-process-attributes-ps-args'.")
+
+(defconst tramp-busybox-process-attributes-ps-format
+ '((pid . number)
+ (user . string)
+ (group . string)
+ (comm . 52)
+ (state . 5)
+ (ppid . number)
+ (pgrp . number)
+ (ttname . string)
+ (time . tramp-ps-time)
+ (nice . number)
+ (etime . tramp-ps-time)
+ (args . nil))
+ "Alist of formats for \"ps\".
+See `tramp-process-attributes-ps-format'.")
+
+(defconst tramp-connection-local-busybox-ps-variables
+ `((tramp-process-attributes-ps-args
+ . ,tramp-busybox-process-attributes-ps-args)
+ (tramp-process-attributes-ps-format
+ . ,tramp-busybox-process-attributes-ps-format))
+ "Default connection-local ps variables for remote Busybox connections.")
+
+(connection-local-set-profile-variables
+ 'tramp-connection-local-busybox-ps-profile
+ tramp-connection-local-busybox-ps-variables)
+
+;; Darwin (macOS).
+(defconst tramp-darwin-process-attributes-ps-args
+ `("-acxww"
+ "-o"
+ ,(mapconcat
+ #'identity
+ '("pid"
+ "uid"
+ "user"
+ "gid"
+ "comm=abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ")
+ ",")
+ "-o" "state=abcde"
+ "-o"
+ ,(mapconcat
+ #'identity
+ '("ppid"
+ "pgid"
+ "sess"
+ "tty"
+ "tpgid"
+ "minflt"
+ "majflt"
+ "time"
+ "pri"
+ "nice"
+ "vsz"
+ "rss"
+ "etime"
+ "pcpu"
+ "pmem"
+ "args")
+ ","))
+ "List of arguments for \"ps\".
+See `tramp-process-attributes-ps-args'.")
+
+(defconst tramp-darwin-process-attributes-ps-format
+ '((pid . number)
+ (euid . number)
+ (user . string)
+ (egid . number)
+ (comm . 52)
+ (state . 5)
+ (ppid . number)
+ (pgrp . number)
+ (sess . number)
+ (ttname . string)
+ (tpgid . number)
+ (minflt . number)
+ (majflt . number)
+ (time . tramp-ps-time)
+ (pri . number)
+ (nice . number)
+ (vsize . number)
+ (rss . number)
+ (etime . tramp-ps-time)
+ (pcpu . number)
+ (pmem . number)
+ (args . nil))
+ "Alist of formats for \"ps\".
+See `tramp-process-attributes-ps-format'.")
+
+(defconst tramp-connection-local-darwin-ps-variables
+ `((tramp-process-attributes-ps-args
+ . ,tramp-darwin-process-attributes-ps-args)
+ (tramp-process-attributes-ps-format
+ . ,tramp-darwin-process-attributes-ps-format))
+ "Default connection-local ps variables for remote Darwin connections.")
+
+(connection-local-set-profile-variables
+ 'tramp-connection-local-darwin-ps-profile
+ tramp-connection-local-darwin-ps-variables)
+
+;; Preset default "ps" profile for local hosts, based on system type.
+
+(when-let ((local-profile
+ (cond ((eq system-type 'darwin)
+ 'tramp-connection-local-darwin-ps-profile)
+ ;; ... Add other system types here.
+ )))
+ (connection-local-set-profiles
+ `(:application tramp :machine ,(system-name))
+ local-profile)
+ (connection-local-set-profiles
+ '(:application tramp :machine "localhost")
+ local-profile))
+
(add-hook 'tramp-unload-hook
(lambda () (unload-feature 'tramp-integration 'force)))
diff --git a/tramp-rclone.el b/tramp-rclone.el
index 318df2de61..8e583cc402 100644
--- a/tramp-rclone.el
+++ b/tramp-rclone.el
@@ -71,7 +71,8 @@
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-rclone-file-name-handler-alist
- '((access-file . tramp-handle-access-file)
+ '(;; `abbreviate-file-name' performed by default handler.
+ (access-file . tramp-handle-access-file)
(add-name-to-file . tramp-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
(copy-directory . tramp-handle-copy-directory)
@@ -110,7 +111,7 @@
(file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
(file-notify-valid-p . tramp-handle-file-notify-valid-p)
(file-ownership-preserved-p . ignore)
- (file-readable-p . tramp-fuse-handle-file-readable-p)
+ (file-readable-p . tramp-rclone-handle-file-readable-p)
(file-regular-p . tramp-handle-file-regular-p)
(file-remote-p . tramp-handle-file-remote-p)
(file-selinux-context . tramp-handle-file-selinux-context)
@@ -122,6 +123,7 @@
;; `get-file-buffer' performed by default handler.
(insert-directory . tramp-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
+ (list-system-processes . ignore)
(load . tramp-handle-load)
(lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
@@ -131,6 +133,8 @@
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
(make-symbolic-link . tramp-handle-make-symbolic-link)
+ (memory-info . ignore)
+ (process-attributes . ignore)
(process-file . ignore)
(rename-file . tramp-rclone-handle-rename-file)
(set-file-acl . ignore)
@@ -142,7 +146,9 @@
(start-file-process . ignore)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-home-directory . ignore)
(tramp-get-remote-gid . ignore)
+ (tramp-get-remote-groups . ignore)
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
@@ -156,11 +162,10 @@ Operations not mentioned here will be handled by the
default Emacs primitives.")
;; It must be a `defsubst' in order to push the whole code into
;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
;;;###tramp-autoload
-(defsubst tramp-rclone-file-name-p (filename)
- "Check if it's a FILENAME for rclone."
- (and (tramp-tramp-file-p filename)
- (string= (tramp-file-name-method (tramp-dissect-file-name filename))
- tramp-rclone-method)))
+(defsubst tramp-rclone-file-name-p (vec-or-filename)
+ "Check if it's a VEC-OR-FILENAME for rclone."
+ (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
+ (string= (tramp-file-name-method vec) tramp-rclone-method)))
;;;###tramp-autoload
(defun tramp-rclone-file-name-handler (operation &rest args)
@@ -183,7 +188,7 @@ arguments to pass to the OPERATION."
(delq nil
(mapcar
(lambda (line)
- (when (string-match "^\\(\\S-+\\):$" line)
+ (when (string-match (rx bol (group (+ (not blank))) ":" eol) line)
`(nil ,(match-string 1 line))))
(tramp-process-lines nil tramp-rclone-program "listremotes")))))
@@ -207,6 +212,7 @@ This function is invoked by `tramp-rclone-handle-copy-file'
and
`tramp-rclone-handle-rename-file'. It is an error if OP is neither
of `copy' and `rename'. FILENAME and NEWNAME must be absolute
file names."
+ ;; FILENAME and NEWNAME are already expanded.
(unless (memq op '(copy rename))
(error "Unknown operation `%s', must be `copy' or `rename'" op))
@@ -222,46 +228,45 @@ file names."
(msg-operation (if (eq op 'copy) "Copying" "Renaming")))
(with-parsed-tramp-file-name (if t1 filename newname) nil
- (unless (file-exists-p filename)
- (tramp-compat-file-missing v filename))
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-error "File is a directory %s" newname))
-
- (if (or (and t1 (not (tramp-rclone-file-name-p filename)))
- (and t2 (not (tramp-rclone-file-name-p newname))))
-
- ;; We cannot copy or rename directly.
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (if (eq op 'copy)
- (copy-file
- filename tmpfile t keep-date preserve-uid-gid
- preserve-extended-attributes)
- (rename-file filename tmpfile t))
- (rename-file tmpfile newname ok-if-already-exists))
-
- ;; Direct action.
- (with-tramp-progress-reporter
- v 0 (format "%s %s to %s" msg-operation filename newname)
- (unless (zerop
- (tramp-rclone-send-command
- v rclone-operation
- (tramp-rclone-remote-file-name filename)
- (tramp-rclone-remote-file-name newname)))
- (tramp-error
- v 'file-error
- "Error %s `%s' `%s'" msg-operation filename newname)))
-
- (when (and t1 (eq op 'rename))
- (while (file-exists-p filename)
- (with-parsed-tramp-file-name filename v1
- (tramp-flush-file-properties v1 v1-localname))))
-
- (when t2
- (with-parsed-tramp-file-name newname v2
- (tramp-flush-file-properties v2 v2-localname))))))))
+ (tramp-barf-if-file-missing v filename
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-error "File is a directory %s" newname))
+
+ (if (or (and t1 (not (tramp-rclone-file-name-p filename)))
+ (and t2 (not (tramp-rclone-file-name-p newname))))
+
+ ;; We cannot copy or rename directly.
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
+ (if (eq op 'copy)
+ (copy-file
+ filename tmpfile t keep-date preserve-uid-gid
+ preserve-extended-attributes)
+ (rename-file filename tmpfile t))
+ (rename-file tmpfile newname ok-if-already-exists))
+
+ ;; Direct action.
+ (with-tramp-progress-reporter
+ v 0 (format "%s %s to %s" msg-operation filename newname)
+ (unless (zerop
+ (tramp-rclone-send-command
+ v rclone-operation
+ (tramp-rclone-remote-file-name filename)
+ (tramp-rclone-remote-file-name newname)))
+ (tramp-error
+ v 'file-error
+ "Error %s `%s' `%s'" msg-operation filename newname)))
+
+ (when (and t1 (eq op 'rename))
+ (while (file-exists-p filename)
+ (with-parsed-tramp-file-name filename v1
+ (tramp-flush-file-properties v1 v1-localname))))
+
+ (when t2
+ (with-parsed-tramp-file-name newname v2
+ (tramp-flush-file-properties v2 v2-localname)))))))))
(defun tramp-rclone-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
@@ -280,6 +285,12 @@ file names."
(list filename newname ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes))))
+(defun tramp-rclone-handle-file-readable-p (filename)
+ "Like `file-readable-p' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (with-tramp-file-property v localname "file-readable-p"
+ (file-readable-p (tramp-fuse-local-file-name filename)))))
+
(defun tramp-rclone-handle-file-system-info (filename)
"Like `file-system-info' for Tramp files."
(ignore-errors
@@ -292,11 +303,11 @@ file names."
(let (total used free)
(goto-char (point-min))
(while (not (eobp))
- (when (looking-at "Total: [[:space:]]+\\([[:digit:]]+\\)")
+ (when (looking-at (rx "Total: " (+ blank) (group (+ digit))))
(setq total (string-to-number (match-string 1))))
- (when (looking-at "Used: [[:space:]]+\\([[:digit:]]+\\)")
+ (when (looking-at (rx "Used: " (+ blank) (group (+ digit))))
(setq used (string-to-number (match-string 1))))
- (when (looking-at "Free: [[:space:]]+\\([[:digit:]]+\\)")
+ (when (looking-at (rx "Free: " (+ blank) (group (+ digit))))
(setq free (string-to-number (match-string 1))))
(forward-line))
(when used
@@ -335,7 +346,7 @@ file names."
(tramp-rclone-maybe-open-connection v)
;; TODO: This shall be handled by `expand-file-name'.
(setq localname
- (replace-regexp-in-string "^\\." "" (or localname "")))
+ (replace-regexp-in-string (rx bol ".") "" (or localname "")))
(format "%s%s" (tramp-fuse-mounted-p v) localname)))
;; It is a local file name.
filename))
diff --git a/tramp-sh.el b/tramp-sh.el
index b0e98a31e1..ac5de22cb8 100644
--- a/tramp-sh.el
+++ b/tramp-sh.el
@@ -34,8 +34,11 @@
(eval-when-compile (require 'cl-lib))
(require 'tramp)
+;; `dired-*' declarations can be removed, starting with Emacs 29.1.
+(declare-function dired-compress-file "dired-aux")
(declare-function dired-remove-file "dired-aux")
(defvar dired-compress-file-suffixes)
+;; Added in Emacs 28.1.
(defvar process-file-return-signal-string)
(defvar vc-handled-backends)
(defvar vc-bzr-program)
@@ -78,10 +81,10 @@ the default storage location, e.g. \"$HOME/.sh_history\"."
(string :tag "Redirect to a file")))
;;;###tramp-autoload
-(defconst tramp-display-escape-sequence-regexp "\e[[:digit:];[]+m"
+(defconst tramp-display-escape-sequence-regexp (rx "\e" (+ (any ";[" digit))
"m")
"Terminal control escape sequences for display attributes.")
-(defconst tramp-device-escape-sequence-regexp "\e[[:digit:][]+n"
+(defconst tramp-device-escape-sequence-regexp (rx "\e" (+ (any "[" digit)) "n")
"Terminal control escape sequences for device status.")
;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for
@@ -143,6 +146,12 @@ be auto-detected by Tramp.
The string is used in `tramp-methods'.")
+(defcustom tramp-use-scp-direct-remote-copying nil
+ "Whether to use direct copying between two remote hosts."
+ :group 'tramp
+ :version "29.1"
+ :type 'boolean)
+
;; Initialize `tramp-methods' with the supported methods.
;;;###tramp-autoload
(tramp--with-startup
@@ -179,7 +188,8 @@ The string is used in `tramp-methods'.")
(tramp-remote-shell-args ("-c"))
(tramp-copy-program "scp")
(tramp-copy-args (("-P" "%p") ("-p" "%k")
- ("%x") ("%y") ("-q") ("-r")
("%c")))
+ ("%x") ("%y") ("%z")
+ ("-q") ("-r") ("%c")))
(tramp-copy-keep-date t)
(tramp-copy-recursive t)))
(add-to-list 'tramp-methods
@@ -195,7 +205,8 @@ The string is used in `tramp-methods'.")
(tramp-remote-shell-args ("-c"))
(tramp-copy-program "scp")
(tramp-copy-args (("-P" "%p") ("-p" "%k")
- ("%x") ("%y") ("-q") ("-r")
("%c")))
+ ("%x") ("%y") ("%z")
+ ("-q") ("-r") ("%c")))
(tramp-copy-keep-date t)
(tramp-copy-recursive t)))
(add-to-list 'tramp-methods
@@ -301,7 +312,8 @@ The string is used in `tramp-methods'.")
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
(tramp-connection-timeout 10)
- (tramp-session-timeout 300)))
+ (tramp-session-timeout 300)
+ (tramp-password-previous-hop t)))
(add-to-list 'tramp-methods
`("doas"
(tramp-login-program "doas")
@@ -309,7 +321,8 @@ The string is used in `tramp-methods'.")
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-args ("-c"))
(tramp-connection-timeout 10)
- (tramp-session-timeout 300)))
+ (tramp-session-timeout 300)
+ (tramp-password-previous-hop t)))
(add-to-list 'tramp-methods
`("ksu"
(tramp-login-program "ksu")
@@ -397,19 +410,18 @@ The string is used in `tramp-methods'.")
(tramp-copy-keep-date t)))
(add-to-list 'tramp-default-method-alist
- `(,tramp-local-host-regexp "\\`root\\'" "su"))
+ `(,tramp-local-host-regexp
+ ,(tramp-compat-rx bos (literal tramp-root-id-string) eos) "su"))
(add-to-list 'tramp-default-user-alist
- `(,(concat "\\`" (regexp-opt '("su" "sudo" "doas" "ksu")) "\\'")
- nil "root"))
+ `(,(rx bos (| "su" "sudo" "doas" "ksu") eos)
+ nil ,tramp-root-id-string))
;; Do not add "ssh" based methods, otherwise ~/.ssh/config would be ignored.
;; Do not add "plink" based methods, they ask interactively for the user.
(add-to-list 'tramp-default-user-alist
- `(,(concat
- "\\`"
- (regexp-opt
- '("rcp" "remcp" "rsh" "telnet" "nc" "krlogin" "fcp"))
- "\\'")
+ `(,(rx bos
+ (| "rcp" "remcp" "rsh" "telnet" "nc" "krlogin" "fcp")
+ eos)
nil ,(user-login-name))))
;;;###tramp-autoload
@@ -504,8 +516,8 @@ The string is used in `tramp-methods'.")
(tramp-set-completion-function "fcp" tramp-completion-function-alist-ssh))
(defcustom tramp-sh-extra-args
- '(("/bash\\'" . "-noediting -norc -noprofile")
- ("/zsh\\'" . "-f +Z -V"))
+ `((,(rx "/bash" eos) . "-noediting -norc -noprofile")
+ (,(rx "/zsh" eos) . "-f +Z -V"))
"Alist specifying extra arguments to pass to the remote shell.
Entries are (REGEXP . ARGS) where REGEXP is a regular expression
matching the shell file name and ARGS is a string specifying the
@@ -653,14 +665,14 @@ else
{
$type = \"nil\"
};
-$uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) .
\"\\\"\";
-$gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) .
\"\\\"\";
printf(
- \"(%%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u %%u t %%u -1)\\n\",
+ \"(%%s %%u (%%s . %%u) (%%s . %%u) (%%u %%u) (%%u %%u) (%%u %%u) %%u %%u t
%%u -1)\\n\",
$type,
$stat[3],
- $uid,
- $gid,
+ \"\\\"\" . getpwuid($stat[4]) . \"\\\"\",
+ $stat[4],
+ \"\\\"\" . getgrgid($stat[5]) . \"\\\"\",
+ $stat[5],
$stat[8] >> 16 & 0xffff,
$stat[8] & 0xffff,
$stat[9] >> 16 & 0xffff,
@@ -670,12 +682,29 @@ printf(
$stat[7],
$stat[2],
$stat[1]
-);' \"$1\" \"$2\" %n"
+);' \"$1\" %n"
"Perl script to produce output suitable for use with `file-attributes'
on the remote file system.
Format specifiers are replaced by `tramp-expand-script', percent
characters need to be doubled.")
+(defconst tramp-stat-file-attributes
+ (format
+ (concat
+ "(%%s -c"
+ " '((%s%%%%N%s) %%%%h (%s%%%%U%s . %%%%u) (%s%%%%G%s . %%%%g)"
+ " %%%%X %%%%Y %%%%Z %%%%s %s%%%%A%s t %%%%i -1)' \"$1\" %%n || echo nil) |"
+ " sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'")
+ tramp-stat-marker tramp-stat-marker ; %%N
+ tramp-stat-marker tramp-stat-marker ; %%U
+ tramp-stat-marker tramp-stat-marker ; %%G
+ tramp-stat-marker tramp-stat-marker ; %%A
+ tramp-stat-quoted-marker)
+ "Shell function to produce output suitable for use with `file-attributes'
+on the remote file system.
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
+
(defconst tramp-perl-directory-files-and-attributes
"%p -e '
chdir($ARGV[0]) or printf(\"\\\"Cannot change to $ARGV[0]: $''!''\\\"\\n\"),
exit();
@@ -702,16 +731,16 @@ for($i = 0; $i < $n; $i++)
{
$type = \"nil\"
};
- $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" .
getpwuid($stat[4]) . \"\\\"\";
- $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" .
getgrgid($stat[5]) . \"\\\"\";
$filename =~ s/\"/\\\\\"/g;
printf(
- \"(\\\"%%s\\\" %%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u %%u t
%%u -1)\\n\",
+ \"(\\\"%%s\\\" %%s %%u (%%s . %%u) (%%s . %%u) (%%u %%u) (%%u %%u)
(%%u %%u) %%u %%u t %%u -1)\\n\",
$filename,
$type,
$stat[3],
- $uid,
- $gid,
+ \"\\\"\" . getpwuid($stat[4]) . \"\\\"\",
+ $stat[4],
+ \"\\\"\" . getgrgid($stat[5]) . \"\\\"\",
+ $stat[5],
$stat[8] >> 16 & 0xffff,
$stat[8] & 0xffff,
$stat[9] >> 16 & 0xffff,
@@ -722,12 +751,73 @@ for($i = 0; $i < $n; $i++)
$stat[2],
$stat[1]);
}
-printf(\")\\n\");' \"$1\" \"$2\" %n"
+printf(\")\\n\");' \"$1\" %n"
"Perl script implementing `directory-files-and-attributes' as Lisp `read'able
output.
Format specifiers are replaced by `tramp-expand-script', percent
characters need to be doubled.")
+(defconst tramp-stat-directory-files-and-attributes
+ (format
+ (concat
+ ;; We must care about file names with spaces, or starting with
+ ;; "-"; this would confuse xargs. "ls -aQ" might be a solution,
+ ;; but it does not work on all remote systems. Therefore, we use
+ ;; \000 as file separator. `tramp-sh--quoting-style-options' do
+ ;; not work for file names with spaces piped to "xargs".
+ ;; Apostrophes in the stat output are masked as
+ ;; `tramp-stat-marker', in order to make a proper shell escape of
+ ;; them in file names.
+ "cd \"$1\" && echo \"(\"; (%%l -a | tr '\\n\\r' '\\000\\000' |"
+ " xargs -0 %%s -c"
+ " '(%s%%%%n%s (%s%%%%N%s) %%%%h (%s%%%%U%s . %%%%u) (%s%%%%G%s . %%%%g)
%%%%X %%%%Y %%%%Z %%%%s %s%%%%A%s t %%%%i -1)'"
+ " -- %%n | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\"")
+ tramp-stat-marker tramp-stat-marker ; %n
+ tramp-stat-marker tramp-stat-marker ; %N
+ tramp-stat-marker tramp-stat-marker ; %U
+ tramp-stat-marker tramp-stat-marker ; %G
+ tramp-stat-marker tramp-stat-marker ; %A
+ tramp-stat-quoted-marker)
+ "Shell function implementing `directory-files-and-attributes' as Lisp
+`read'able output.
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
+
+(defconst tramp-perl-id
+ "%p -e '
+use strict;
+use warnings;
+use POSIX qw(getgroups);
+
+my ( $uid, $user ) = ( $>, scalar getpwuid $> );
+my ( $gid, $group ) = ( $), scalar getgrgid $) );
+my @groups = map { $_ . \"(\" . getgrgid ($_) . \")\" } getgroups ();
+
+printf \"uid=%%d(%%s) gid=%%d(%%s) groups=%%s\\n\",
+ $uid, $user, $gid, $group, join \",\", @groups;' %n"
+ "Perl script printing `id' output.
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
+
+(defconst tramp-python-id
+ "%y -c '
+import os, pwd, grp;
+
+def idform(id):
+ return \"{:d}({:s})\".format(id, grp.getgrgid(id)[0]);
+
+uid = os.getuid();
+user = pwd.getpwuid(uid)[0];
+gid = os.getgid();
+group = grp.getgrgid(gid)[0]
+groups = map(idform, os.getgrouplist(user, gid));
+
+print(\"uid={:d}({:s}) gid={:d}({:s}) groups={:s}\"
+ .format(uid, user, gid, group, \",\".join(groups)));' %n"
+ "Python script printing `id' output.
+Format specifiers are replaced by `tramp-expand-script', percent
+characters need to be doubled.")
+
;; These two use base64 encoding.
(defconst tramp-perl-encode-with-module
"%p -MMIME::Base64 -0777 -ne 'print encode_base64($_)' %n"
@@ -949,7 +1039,8 @@ Format specifiers \"%s\" are replaced before the script is
used.")
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-sh-file-name-handler-alist
- '((access-file . tramp-handle-access-file)
+ '((abbreviate-file-name . tramp-handle-abbreviate-file-name)
+ (access-file . tramp-handle-access-file)
(add-name-to-file . tramp-sh-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
(copy-directory . tramp-sh-handle-copy-directory)
@@ -961,6 +1052,8 @@ Format specifiers \"%s\" are replaced before the script is
used.")
(directory-files . tramp-handle-directory-files)
(directory-files-and-attributes
. tramp-sh-handle-directory-files-and-attributes)
+ ;; Starting with Emacs 29.1, `dired-compress-file' performed by
+ ;; default handler.
(dired-compress-file . tramp-sh-handle-dired-compress-file)
(dired-uncache . tramp-handle-dired-uncache)
(exec-path . tramp-sh-handle-exec-path)
@@ -1000,6 +1093,7 @@ Format specifiers \"%s\" are replaced before the script
is used.")
;; `get-file-buffer' performed by default handler.
(insert-directory . tramp-sh-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
+ (list-system-processes . tramp-handle-list-system-processes)
(load . tramp-handle-load)
(lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
@@ -1009,6 +1103,8 @@ Format specifiers \"%s\" are replaced before the script
is used.")
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . tramp-sh-handle-make-process)
(make-symbolic-link . tramp-sh-handle-make-symbolic-link)
+ (memory-info . tramp-handle-memory-info)
+ (process-attributes . tramp-handle-process-attributes)
(process-file . tramp-sh-handle-process-file)
(rename-file . tramp-sh-handle-rename-file)
(set-file-acl . tramp-sh-handle-set-file-acl)
@@ -1020,7 +1116,9 @@ Format specifiers \"%s\" are replaced before the script
is used.")
(start-file-process . tramp-handle-start-file-process)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-home-directory . tramp-sh-handle-get-home-directory)
(tramp-get-remote-gid . tramp-sh-handle-get-remote-gid)
+ (tramp-get-remote-groups . tramp-sh-handle-get-remote-groups)
(tramp-get-remote-uid . tramp-sh-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-sh-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore)
@@ -1039,63 +1137,63 @@ Operations not mentioned here will be handled by the
normal Emacs functions.")
If TARGET is a non-Tramp file, it is used verbatim as the target
of the symlink. If TARGET is a Tramp file, only the localname
component is used as the target of the symlink."
- (if (not (tramp-tramp-file-p (expand-file-name linkname)))
- (tramp-run-real-handler
- #'make-symbolic-link (list target linkname ok-if-already-exists))
-
- (with-parsed-tramp-file-name linkname nil
- ;; If TARGET is a Tramp name, use just the localname component.
- ;; Don't check for a proper method.
- (let ((non-essential t))
- (when (and (tramp-tramp-file-p target)
- (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
- (setq target (tramp-file-local-name (expand-file-name target)))))
-
- ;; If TARGET is still remote, quote it.
- (if (tramp-tramp-file-p target)
- (make-symbolic-link (tramp-compat-file-name-quote target 'top)
- linkname ok-if-already-exists)
-
- (let ((ln (tramp-get-remote-ln v))
- (cwd (tramp-run-real-handler
- #'file-name-directory (list localname))))
- (unless ln
- (tramp-error
- v 'file-error
- (concat "Making a symbolic link. "
- "ln(1) does not exist on the remote host.")))
-
- ;; Do the 'confirm if exists' thing.
- (when (file-exists-p linkname)
- ;; What to do?
- (if (or (null ok-if-already-exists) ; not allowed to exist
- (and (numberp ok-if-already-exists)
- (not
- (yes-or-no-p
- (format
- "File %s already exists; make it a link anyway?"
- localname)))))
- (tramp-error v 'file-already-exists localname)
- (delete-file linkname)))
-
- (tramp-flush-file-properties v localname)
-
- ;; Right, they are on the same host, regardless of user,
- ;; method, etc. We now make the link on the remote
- ;; machine. This will occur as the user that TARGET belongs to.
- (and (tramp-send-command-and-check
- v (format "cd %s" (tramp-shell-quote-argument cwd)))
- (tramp-send-command-and-check
- v (format
- "%s -sf %s %s" ln
- (tramp-shell-quote-argument target)
- ;; The command could exceed PATH_MAX, so we use
- ;; relative file names. However, relative file
- ;; names could start with "-".
- ;; `tramp-shell-quote-argument' does not handle
- ;; this, we must do it ourselves.
- (tramp-shell-quote-argument
- (concat "./" (file-name-nondirectory localname)))))))))))
+ (with-parsed-tramp-file-name (expand-file-name linkname) nil
+ ;; If TARGET is a Tramp name, use just the localname component.
+ ;; Don't check for a proper method.
+ (let ((non-essential t))
+ (when (and (tramp-tramp-file-p target)
+ (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
+ (setq target (tramp-file-local-name (expand-file-name target))))
+ ;; There could be a cyclic link.
+ (tramp-flush-file-properties
+ v (expand-file-name target (tramp-file-local-name default-directory))))
+
+ ;; If TARGET is still remote, quote it.
+ (if (tramp-tramp-file-p target)
+ (make-symbolic-link
+ (tramp-compat-file-name-quote target 'top)
+ linkname ok-if-already-exists)
+
+ (let ((ln (tramp-get-remote-ln v))
+ (cwd (tramp-run-real-handler
+ #'file-name-directory (list localname))))
+ (unless ln
+ (tramp-error
+ v 'file-error
+ (concat "Making a symbolic link. "
+ "ln(1) does not exist on the remote host.")))
+
+ ;; Do the 'confirm if exists' thing.
+ (when (file-exists-p linkname)
+ ;; What to do?
+ (if (or (null ok-if-already-exists) ; not allowed to exist
+ (and (numberp ok-if-already-exists)
+ (not
+ (yes-or-no-p
+ (format
+ "File %s already exists; make it a link anyway?"
+ localname)))))
+ (tramp-error v 'file-already-exists localname)
+ (delete-file linkname)))
+
+ (tramp-flush-file-properties v localname)
+
+ ;; Right, they are on the same host, regardless of user,
+ ;; method, etc. We now make the link on the remote machine.
+ ;; This will occur as the user that TARGET belongs to.
+ (and (tramp-send-command-and-check
+ v (format "cd %s" (tramp-shell-quote-argument cwd)))
+ (tramp-send-command-and-check
+ v (format
+ "%s -sf %s %s" ln
+ (tramp-shell-quote-argument target)
+ ;; The command could exceed PATH_MAX, so we use
+ ;; relative file names. However, relative file names
+ ;; could start with "-".
+ ;; `tramp-shell-quote-argument' does not handle this,
+ ;; we must do it ourselves.
+ (tramp-shell-quote-argument
+ (concat "./" (file-name-nondirectory localname))))))))))
(defun tramp-sh-handle-file-truename (filename)
"Like `file-truename' for Tramp files."
@@ -1111,36 +1209,32 @@ component is used as the target of the symlink."
(tramp-make-tramp-file-name
v
(with-tramp-file-property v localname "file-truename"
- (let (result) ; result steps in reverse order
- (tramp-message v 4 "Finding true name for `%s'" filename)
- (cond
- ;; Use GNU readlink --canonicalize-missing where available.
- ((tramp-get-remote-readlink v)
- (tramp-send-command-and-check
- v
- (format "%s --canonicalize-missing %s"
- (tramp-get-remote-readlink v)
- (tramp-shell-quote-argument localname)))
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (setq result (buffer-substring (point-min) (point-at-eol)))))
-
- ;; Use Perl implementation.
- ((and (tramp-get-remote-perl v)
- (tramp-get-connection-property v "perl-file-spec" nil)
- (tramp-get-connection-property v "perl-cwd-realpath" nil))
- (tramp-maybe-send-script
- v tramp-perl-file-truename "tramp_perl_file_truename")
- (setq result
- (tramp-send-command-and-read
- v
- (format "tramp_perl_file_truename %s"
- (tramp-shell-quote-argument localname)))))
-
- ;; Do it yourself.
- (t (setq
- result
- (tramp-file-local-name (tramp-handle-file-truename filename)))))
+ (tramp-message v 4 "Finding true name for `%s'" filename)
+ (let ((result
+ (cond
+ ;; Use GNU readlink --canonicalize-missing where available.
+ ((tramp-get-remote-readlink v)
+ (tramp-send-command-and-check
+ v (format "%s --canonicalize-missing %s"
+ (tramp-get-remote-readlink v)
+ (tramp-shell-quote-argument localname)))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (buffer-substring (point-min) (line-end-position))))
+
+ ;; Use Perl implementation.
+ ((and (tramp-get-remote-perl v)
+ (tramp-get-connection-property v "perl-file-spec")
+ (tramp-get-connection-property v "perl-cwd-realpath"))
+ (tramp-maybe-send-script
+ v tramp-perl-file-truename "tramp_perl_file_truename")
+ (tramp-send-command-and-read
+ v (format "tramp_perl_file_truename %s"
+ (tramp-shell-quote-argument localname))))
+
+ ;; Do it yourself.
+ (t (tramp-file-local-name
+ (tramp-handle-file-truename filename))))))
;; Detect cycle.
(when (and (file-symlink-p filename)
@@ -1153,8 +1247,7 @@ component is used as the target of the symlink."
(when (file-remote-p result)
(setq result (tramp-compat-file-name-quote result 'top)))
(tramp-message v 4 "True name of `%s' is `%s'" localname result)
- result))
- 'nohop)))))
+ result)))))))
;; Basic functions.
@@ -1164,41 +1257,32 @@ component is used as the target of the symlink."
;; We don't want to run it when `non-essential' is t, or there is
;; no connection process yet.
(when (tramp-connectable-p filename)
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-exists-p"
- (or (not (null (tramp-get-file-property
- v localname "file-attributes-integer" nil)))
- (not (null (tramp-get-file-property
- v localname "file-attributes-string" nil)))
- (tramp-send-command-and-check
- v
- (format
- "%s %s"
- (tramp-get-file-exists-command v)
- (tramp-shell-quote-argument localname))))))))
+ (if (tramp-file-property-p v localname "file-attributes")
+ (not (null (tramp-get-file-property v localname "file-attributes")))
+ (tramp-send-command-and-check
+ v
+ (format
+ "%s %s"
+ (tramp-get-file-exists-command v)
+ (tramp-shell-quote-argument localname))))))))
(defun tramp-sh-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
- (unless id-format (setq id-format 'integer))
- (ignore-errors
- ;; Don't modify `last-coding-system-used' by accident.
- (let ((last-coding-system-used last-coding-system-used))
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-file-property
- v localname (format "file-attributes-%s" id-format)
- (tramp-convert-file-attributes
- v
- (or
- (cond
- ((tramp-get-remote-stat v)
- (tramp-do-file-attributes-with-stat v localname id-format))
- ((tramp-get-remote-perl v)
- (tramp-do-file-attributes-with-perl v localname id-format))
- (t nil))
- ;; The scripts could fail, for example with huge file size.
- (tramp-do-file-attributes-with-ls v localname id-format))))))))
-
-(defconst tramp-sunos-unames (regexp-opt '("SunOS 5.10" "SunOS 5.11"))
+ ;; The result is cached in `tramp-convert-file-attributes'.
+ ;; Don't modify `last-coding-system-used' by accident.
+ (let ((last-coding-system-used last-coding-system-used))
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (tramp-convert-file-attributes v localname id-format
+ (cond
+ ((tramp-get-remote-stat v)
+ (tramp-do-file-attributes-with-stat v localname))
+ ((tramp-get-remote-perl v)
+ (tramp-do-file-attributes-with-perl v localname))
+ (t (tramp-do-file-attributes-with-ls v localname)))))))
+
+(defconst tramp-sunos-unames (rx (| "SunOS 5.10" "SunOS 5.11"))
"Regexp to determine remote SunOS.")
(defun tramp-sh--quoting-style-options (vec)
@@ -1212,29 +1296,40 @@ component is used as the target of the symlink."
(tramp-get-ls-command-with vec "-w"))
""))
-(defun tramp-do-file-attributes-with-ls (vec localname &optional id-format)
+(defun tramp-do-file-attributes-with-ls (vec localname)
"Implement `file-attributes' for Tramp files using the ls(1) command."
(let (symlinkp dirp
res-inode res-filemodes res-numlinks
- res-uid res-gid res-size res-symlink-target)
+ res-uid-string res-gid-string res-uid-integer res-gid-integer
+ res-size res-symlink-target)
(tramp-message vec 5 "file attributes with ls: %s" localname)
;; We cannot send all three commands combined, it could exceed
;; NAME_MAX or PATH_MAX. Happened on macOS, for example.
- (when (or (tramp-send-command-and-check
- vec
- (format "%s %s"
- (tramp-get-file-exists-command vec)
- (tramp-shell-quote-argument localname)))
- (tramp-send-command-and-check
- vec
- (format "%s -h %s"
- (tramp-get-test-command vec)
- (tramp-shell-quote-argument localname))))
+ (when (tramp-send-command-and-check
+ vec
+ (format "cd %s && (%s %s || %s -h %s)"
+ (tramp-shell-quote-argument
+ (tramp-run-real-handler
+ #'file-name-directory (list localname)))
+ (tramp-get-file-exists-command vec)
+ (if (string-empty-p (file-name-nondirectory localname))
+ "."
+ (tramp-shell-quote-argument
+ (file-name-nondirectory localname)))
+ (tramp-get-test-command vec)
+ (if (string-empty-p (file-name-nondirectory localname))
+ "."
+ (tramp-shell-quote-argument
+ (file-name-nondirectory localname)))))
(tramp-send-command
vec
- (format "%s %s %s %s"
+ (format "%s -ild %s %s; %s -lnd %s %s"
+ (tramp-get-ls-command vec)
+ ;; On systems which have no quoting style, file names
+ ;; with special characters could fail.
+ (tramp-sh--quoting-style-options vec)
+ (tramp-shell-quote-argument localname)
(tramp-get-ls-command vec)
- (if (eq id-format 'integer) "-ildn" "-ild")
;; On systems which have no quoting style, file names
;; with special characters could fail.
(tramp-sh--quoting-style-options vec)
@@ -1250,17 +1345,16 @@ component is used as the target of the symlink."
;; ... number links
(setq res-numlinks (read (current-buffer)))
;; ... uid and gid
- (setq res-uid (read (current-buffer)))
- (setq res-gid (read (current-buffer)))
- (if (eq id-format 'integer)
- (progn
- (unless (numberp res-uid)
- (setq res-uid tramp-unknown-id-integer))
- (unless (numberp res-gid)
- (setq res-gid tramp-unknown-id-integer)))
- (progn
- (unless (stringp res-uid) (setq res-uid (symbol-name res-uid)))
- (unless (stringp res-gid) (setq res-gid (symbol-name res-gid)))))
+ (setq res-uid-string (read (current-buffer)))
+ (setq res-gid-string (read (current-buffer)))
+ (when (natnump res-uid-string)
+ (setq res-uid-string (number-to-string res-uid-string)))
+ (unless (stringp res-uid-string)
+ (setq res-uid-string (symbol-name res-uid-string)))
+ (when (natnump res-gid-string)
+ (setq res-gid-string (number-to-string res-gid-string)))
+ (unless (stringp res-gid-string)
+ (setq res-gid-string (symbol-name res-gid-string)))
;; ... size
(setq res-size (read (current-buffer)))
;; From the file modes, figure out other stuff.
@@ -1272,8 +1366,21 @@ component is used as the target of the symlink."
(setq res-symlink-target
(if (looking-at-p "\"")
(read (current-buffer))
- (buffer-substring (point) (point-at-eol)))))
- ;; Return data gathered.
+ (buffer-substring (point) (line-end-position)))))
+ (forward-line)
+ ;; ... file mode flags
+ (read (current-buffer))
+ ;; ... number links
+ (read (current-buffer))
+ ;; ... uid and gid
+ (setq res-uid-integer (read (current-buffer)))
+ (setq res-gid-integer (read (current-buffer)))
+ (unless (numberp res-uid-integer)
+ (setq res-uid-integer tramp-unknown-id-integer))
+ (unless (numberp res-gid-integer)
+ (setq res-gid-integer tramp-unknown-id-integer))
+
+ ;; Return data gathered.
(list
;; 0. t for directory, string (name linked to) for symbolic
;; link, or nil.
@@ -1281,9 +1388,9 @@ component is used as the target of the symlink."
;; 1. Number of links to file.
res-numlinks
;; 2. File uid.
- res-uid
+ (cons res-uid-string res-uid-integer)
;; 3. File gid.
- res-gid
+ (cons res-gid-string res-gid-integer)
;; 4. Last access time.
;; 5. Last modification time.
;; 6. Last status change time.
@@ -1300,42 +1407,23 @@ component is used as the target of the symlink."
;; 11. Device number. Will be replaced by a virtual device number.
-1))))))
-(defun tramp-do-file-attributes-with-perl
- (vec localname &optional id-format)
+(defun tramp-do-file-attributes-with-perl (vec localname)
"Implement `file-attributes' for Tramp files using a Perl script."
(tramp-message vec 5 "file attributes with perl: %s" localname)
(tramp-maybe-send-script
vec tramp-perl-file-attributes "tramp_perl_file_attributes")
(tramp-send-command-and-read
- vec
- (format "tramp_perl_file_attributes %s %s"
- (tramp-shell-quote-argument localname) id-format)))
+ vec (format "tramp_perl_file_attributes %s"
+ (tramp-shell-quote-argument localname))))
-(defun tramp-do-file-attributes-with-stat
- (vec localname &optional id-format)
+(defun tramp-do-file-attributes-with-stat (vec localname)
"Implement `file-attributes' for Tramp files using stat(1) command."
(tramp-message vec 5 "file attributes with stat: %s" localname)
+ (tramp-maybe-send-script
+ vec tramp-stat-file-attributes "tramp_stat_file_attributes")
(tramp-send-command-and-read
- vec
- (format
- (concat
- ;; Apostrophes in the stat output are masked as
- ;; `tramp-stat-marker', in order to make a proper shell escape of
- ;; them in file names.
- "(%s -c '((%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' %s |"
- " sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g')")
- (tramp-get-remote-stat vec)
- tramp-stat-marker tramp-stat-marker
- (if (eq id-format 'integer)
- "%u"
- (eval-when-compile (concat tramp-stat-marker "%U" tramp-stat-marker)))
- (if (eq id-format 'integer)
- "%g"
- (eval-when-compile (concat tramp-stat-marker "%G" tramp-stat-marker)))
- tramp-stat-marker tramp-stat-marker
- (tramp-shell-quote-argument localname)
- tramp-stat-quoted-marker)
- 'noerror))
+ vec (format "tramp_stat_file_attributes %s"
+ (tramp-shell-quote-argument localname))))
(defun tramp-sh-handle-set-visited-file-modtime (&optional time-list)
"Like `set-visited-file-modtime' for Tramp files."
@@ -1344,12 +1432,12 @@ component is used as the target of the symlink."
(buffer-name)))
(if time-list
(tramp-run-real-handler #'set-visited-file-modtime (list time-list))
- (let ((f (buffer-file-name))
+ (let ((f (expand-file-name (buffer-file-name)))
coding-system-used)
(with-parsed-tramp-file-name f nil
(let* ((remote-file-name-inhibit-cache t)
(attr (file-attributes f))
- (modtime (or (tramp-compat-file-attribute-modification-time attr)
+ (modtime (or (file-attribute-modification-time attr)
tramp-time-doesnt-exist)))
(setq coding-system-used last-coding-system-used)
(if (not (tramp-compat-time-equal-p modtime tramp-time-dont-know))
@@ -1360,7 +1448,7 @@ component is used as the target of the symlink."
(format "%s -ild %s"
(tramp-get-ls-command v)
(tramp-shell-quote-argument localname)))
- (setq attr (buffer-substring (point) (point-at-eol))))
+ (setq attr (buffer-substring (point) (line-end-position))))
(tramp-set-file-property
v localname "visited-file-modtime-ild" attr))
(setq last-coding-system-used coding-system-used)
@@ -1387,7 +1475,7 @@ of."
(with-parsed-tramp-file-name f nil
(let* ((remote-file-name-inhibit-cache t)
(attr (file-attributes f))
- (modtime (tramp-compat-file-attribute-modification-time attr))
+ (modtime (file-attribute-modification-time attr))
(mt (visited-file-modtime)))
(cond
@@ -1404,7 +1492,7 @@ of."
(tramp-get-ls-command v)
(tramp-shell-quote-argument localname)))
(with-current-buffer (tramp-get-buffer v)
- (setq attr (buffer-substring (point) (point-at-eol))))
+ (setq attr (buffer-substring (point) (line-end-position))))
(equal
attr
(tramp-get-file-property
@@ -1415,12 +1503,11 @@ of."
(defun tramp-sh-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- ;; We need "chmod -h" when the flag is set.
- (when (or (not (eq flag 'nofollow))
- (not (file-symlink-p filename))
- (tramp-get-remote-chmod-h v))
- (tramp-flush-file-properties v localname)
+ ;; We need "chmod -h" when the flag is set.
+ (when (or (not (eq flag 'nofollow))
+ (not (file-symlink-p filename))
+ (tramp-get-remote-chmod-h (tramp-dissect-file-name filename)))
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
;; FIXME: extract the proper text from chmod's stderr.
(tramp-barf-unless-okay
v
@@ -1432,44 +1519,88 @@ of."
(defun tramp-sh-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(when (tramp-get-remote-touch v)
- (tramp-flush-file-properties v localname)
(let ((time
(if (or (null time)
(tramp-compat-time-equal-p time tramp-time-doesnt-exist)
(tramp-compat-time-equal-p time tramp-time-dont-know))
- (current-time)
+ nil
time)))
(tramp-send-command-and-check
v (format
- "env TZ=UTC %s %s %s %s"
+ "env TZ=UTC0 %s %s %s %s"
(tramp-get-remote-touch v)
- (if (tramp-get-connection-property v "touch-t" nil)
+ (if (tramp-get-connection-property v "touch-t")
(format "-t %s" (format-time-string "%Y%m%d%H%M.%S" time t))
"")
(if (eq flag 'nofollow) "-h" "")
(tramp-shell-quote-argument localname)))))))
+(defun tramp-sh-handle-get-home-directory (vec &optional user)
+ "The remote home directory for connection VEC as local file name.
+If USER is a string, return its home directory instead of the
+user identified by VEC. If there is no user specified in either
+VEC or USER, or if there is no home directory, return nil."
+ (when (tramp-send-command-and-check
+ vec (format
+ "echo %s"
+ (tramp-shell-quote-argument
+ (concat "~" (or user (tramp-file-name-user vec))))))
+ (with-current-buffer (tramp-get-buffer vec)
+ (goto-char (point-min))
+ (buffer-substring (point) (line-end-position)))))
+
(defun tramp-sh-handle-get-remote-uid (vec id-format)
"The uid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
+ ;; The result is cached in `tramp-get-remote-uid'.
(ignore-errors
(cond
- ((tramp-get-remote-id vec) (tramp-get-remote-uid-with-id vec id-format))
- ((tramp-get-remote-perl vec) (tramp-get-remote-uid-with-perl vec
id-format))
+ ((tramp-get-remote-id vec)
+ (tramp-send-command vec (tramp-get-remote-id vec)))
+ ((tramp-get-remote-perl vec)
+ (tramp-maybe-send-script vec tramp-perl-id "tramp_perl_id")
+ (tramp-send-command vec "tramp_perl_id"))
((tramp-get-remote-python vec)
- (tramp-get-remote-uid-with-python vec id-format)))))
+ (tramp-maybe-send-script vec tramp-python-id "tramp_python_id")
+ (tramp-send-command vec "tramp_python_id")))
+ (tramp-read-id-output vec)
+ (tramp-get-connection-property vec (format "uid-%s" id-format))))
(defun tramp-sh-handle-get-remote-gid (vec id-format)
"The gid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
+ ;; The result is cached in `tramp-get-remote-gid'.
+ (ignore-errors
+ (cond
+ ((tramp-get-remote-id vec)
+ (tramp-send-command vec (tramp-get-remote-id vec)))
+ ((tramp-get-remote-perl vec)
+ (tramp-maybe-send-script vec tramp-perl-id "tramp_perl_id")
+ (tramp-send-command vec "tramp_perl_id"))
+ ((tramp-get-remote-python vec)
+ (tramp-maybe-send-script vec tramp-python-id "tramp_python_id")
+ (tramp-send-command vec "tramp_python_id")))
+ (tramp-read-id-output vec)
+ (tramp-get-connection-property vec (format "gid-%s" id-format))))
+
+(defun tramp-sh-handle-get-remote-groups (vec id-format)
+ "Like `tramp-get-remote-groups' for Tramp files.
+ID-FORMAT valid values are `string' and `integer'."
+ ;; The result is cached in `tramp-get-remote-groups'.
(ignore-errors
(cond
- ((tramp-get-remote-id vec) (tramp-get-remote-gid-with-id vec id-format))
- ((tramp-get-remote-perl vec) (tramp-get-remote-gid-with-perl vec
id-format))
+ ((tramp-get-remote-id vec)
+ (tramp-send-command vec (tramp-get-remote-id vec)))
+ ((tramp-get-remote-perl vec)
+ (tramp-maybe-send-script vec tramp-perl-id "tramp_perl_id")
+ (tramp-send-command vec "tramp_perl_id"))
((tramp-get-remote-python vec)
- (tramp-get-remote-gid-with-python vec id-format)))))
+ (tramp-maybe-send-script vec tramp-python-id "tramp_python_id")
+ (tramp-send-command vec "tramp_python_id")))
+ (tramp-read-id-output vec)
+ (tramp-get-connection-property vec (format "groups-%s" id-format))))
(defun tramp-sh-handle-set-file-uid-gid (filename &optional uid gid)
"Like `tramp-set-file-uid-gid' for Tramp files."
@@ -1477,9 +1608,9 @@ ID-FORMAT valid values are `string' and `integer'."
;; another implementation, see `dired-do-chown'. OTOH, it is mostly
;; working with su(do)? when it is needed, so it shall succeed in
;; the majority of cases.
- ;; Don't modify `last-coding-system-used' by accident.
- (let ((last-coding-system-used last-coding-system-used))
- (with-parsed-tramp-file-name filename nil
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
+ ;; Don't modify `last-coding-system-used' by accident.
+ (let ((last-coding-system-used last-coding-system-used))
(if (and (zerop (user-uid)) (tramp-local-host-p v))
;; If we are root on the local host, we can do it directly.
(tramp-set-file-uid-gid localname uid gid)
@@ -1499,11 +1630,14 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-sh-handle-file-selinux-context (filename)
"Like `file-selinux-context' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-selinux-context"
(let ((context '(nil nil nil nil))
- (regexp (concat "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\):"
- "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\)")))
+ (regexp (tramp-compat-rx
+ (group (+ (any "_" alnum))) ":"
+ (group (+ (any "_" alnum))) ":"
+ (group (+ (any "_" alnum))) ":"
+ (group (+ (any "_" alnum))))))
(when (and (tramp-remote-selinux-p v)
(tramp-send-command-and-check
v (format
@@ -1512,7 +1646,7 @@ ID-FORMAT valid values are `string' and `integer'."
(tramp-shell-quote-argument localname))))
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
- (when (re-search-forward regexp (point-at-eol) t)
+ (when (re-search-forward regexp (line-end-position) t)
(setq context (list (match-string 1) (match-string 2)
(match-string 3) (match-string 4))))))
;; Return the context.
@@ -1520,7 +1654,7 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-sh-handle-set-file-selinux-context (filename context)
"Like `set-file-selinux-context' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(when (and (consp context)
(tramp-remote-selinux-p v))
(let ((user (and (stringp (nth 0 context)) (nth 0 context)))
@@ -1547,7 +1681,7 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-sh-handle-file-acl (filename)
"Like `file-acl' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-acl"
(when (and (tramp-remote-acl-p v)
(tramp-send-command-and-check
@@ -1584,50 +1718,64 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-sh-handle-file-executable-p (filename)
"Like `file-executable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-executable-p"
;; Examine `file-attributes' cache to see if request can be
;; satisfied without remote operation.
- (or (tramp-check-cached-permissions v ?x)
- (tramp-check-cached-permissions v ?s)
- (tramp-run-test "-x" filename)))))
+ (if (tramp-file-property-p v localname "file-attributes")
+ (or (tramp-check-cached-permissions v ?x)
+ (tramp-check-cached-permissions v ?s))
+ (tramp-run-test "-x" filename)))))
(defun tramp-sh-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-readable-p"
- (or (tramp-handle-file-readable-p filename)
- (tramp-run-test "-r" filename)))))
+ ;; Examine `file-attributes' cache to see if request can be
+ ;; satisfied without remote operation.
+ (if (tramp-file-property-p v localname "file-attributes")
+ (tramp-handle-file-readable-p filename)
+ (tramp-run-test "-r" filename)))))
;; Functions implemented using the basic functions above.
(defun tramp-sh-handle-file-directory-p (filename)
"Like `file-directory-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
;; `file-directory-p' is used as predicate for file name completion.
;; Sometimes, when a connection is not established yet, it is
;; desirable to return t immediately for "/method:foo:". It can
;; be expected that this is always a directory.
(or (zerop (length localname))
(with-tramp-file-property v localname "file-directory-p"
- (tramp-run-test "-d" filename)))))
+ (if-let
+ ((truename (tramp-get-file-property v localname "file-truename"))
+ (attr-p (tramp-file-property-p
+ v (tramp-file-local-name truename) "file-attributes")))
+ (eq (file-attribute-type
+ (tramp-get-file-property
+ v (tramp-file-local-name truename) "file-attributes"))
+ t)
+ (tramp-run-test "-d" filename))))))
(defun tramp-sh-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-writable-p"
(if (file-exists-p filename)
- ;; Examine `file-attributes' cache to see if request can be
- ;; satisfied without remote operation.
- (or (tramp-check-cached-permissions v ?w)
- (tramp-run-test "-w" filename))
+ (if (tramp-file-property-p v localname "file-attributes")
+ ;; Examine `file-attributes' cache to see if request can
+ ;; be satisfied without remote operation.
+ (tramp-check-cached-permissions v ?w)
+ (tramp-run-test "-w" filename))
;; If file doesn't exist, check if directory is writable.
- (and (tramp-run-test "-d" (file-name-directory filename))
- (tramp-run-test "-w" (file-name-directory filename)))))))
+ (and
+ (file-directory-p (file-name-directory filename))
+ (file-writable-p (file-name-directory filename)))))))
(defun tramp-sh-handle-file-ownership-preserved-p (filename &optional group)
"Like `file-ownership-preserved-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property
v localname
(format "file-ownership-preserved-p%s" (if group "-group" ""))
@@ -1636,14 +1784,14 @@ ID-FORMAT valid values are `string' and `integer'."
;; information would be lost by an (attempted) delete and create.
(or (null attributes)
(and
- (= (tramp-compat-file-attribute-user-id attributes)
+ (= (file-attribute-user-id attributes)
(tramp-get-remote-uid v 'integer))
(or (not group)
;; On BSD-derived systems files always inherit the
;; parent directory's group, so skip the group-gid
;; test.
- (tramp-check-remote-uname v "BSD\\|DragonFly\\|Darwin")
- (= (tramp-compat-file-attribute-group-id attributes)
+ (tramp-check-remote-uname v (rx (| "BSD" "DragonFly"
"Darwin")))
+ (= (file-attribute-group-id attributes)
(tramp-get-remote-gid v 'integer)))))))))
;; Directory listings.
@@ -1651,52 +1799,18 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-sh-handle-directory-files-and-attributes
(directory &optional full match nosort id-format count)
"Like `directory-files-and-attributes' for Tramp files."
- (unless id-format (setq id-format 'integer))
- (unless (file-exists-p directory)
- (tramp-compat-file-missing
- (tramp-dissect-file-name directory) directory))
- (when (file-directory-p directory)
- (setq directory (expand-file-name directory))
- (let* ((temp
- (copy-tree
- (with-parsed-tramp-file-name directory nil
- (with-tramp-file-property
- v localname
- (format "directory-files-and-attributes-%s" id-format)
- (mapcar
- (lambda (x)
- (cons (car x) (tramp-convert-file-attributes v (cdr x))))
- (cond
- ((tramp-get-remote-stat v)
- (tramp-do-directory-files-and-attributes-with-stat
- v localname id-format))
- ((tramp-get-remote-perl v)
- (tramp-do-directory-files-and-attributes-with-perl
- v localname id-format))
- (t nil)))))))
- result item)
-
- (while temp
- (setq item (pop temp))
- (when (or (null match) (string-match-p match (car item)))
- (when full
- (setcar item (expand-file-name (car item) directory)))
- (push item result)))
-
- (unless nosort
- (setq result (sort result (lambda (x y) (string< (car x) (car y))))))
-
- (when (and (natnump count) (> count 0))
- (setq result (nbutlast result (- (length result) count))))
-
- (or result
- ;; The scripts could fail, for example with huge file size.
- (tramp-handle-directory-files-and-attributes
- directory full match nosort id-format count)))))
+ (tramp-skeleton-directory-files-and-attributes
+ directory full match nosort id-format count
+ (cond
+ ((tramp-get-remote-stat v)
+ (tramp-do-directory-files-and-attributes-with-stat
+ v localname))
+ ((tramp-get-remote-perl v)
+ (tramp-do-directory-files-and-attributes-with-perl
+ v localname)))))
;; FIXME: Fix function to work with count parameter.
-(defun tramp-do-directory-files-and-attributes-with-perl
- (vec localname &optional id-format)
+(defun tramp-do-directory-files-and-attributes-with-perl (vec localname)
"Implement `directory-files-and-attributes' for Tramp files using a Perl
script."
(tramp-message vec 5 "directory-files-and-attributes with perl: %s"
localname)
(tramp-maybe-send-script
@@ -1704,59 +1818,31 @@ ID-FORMAT valid values are `string' and `integer'."
"tramp_perl_directory_files_and_attributes")
(let ((object
(tramp-send-command-and-read
- vec
- (format "tramp_perl_directory_files_and_attributes %s %s"
- (tramp-shell-quote-argument localname) id-format))))
+ vec (format "tramp_perl_directory_files_and_attributes %s"
+ (tramp-shell-quote-argument localname)))))
(when (stringp object) (tramp-error vec 'file-error object))
object))
;; FIXME: Fix function to work with count parameter.
-(defun tramp-do-directory-files-and-attributes-with-stat
- (vec localname &optional id-format)
+(defun tramp-do-directory-files-and-attributes-with-stat (vec localname)
"Implement `directory-files-and-attributes' for Tramp files with stat(1)
command."
(tramp-message vec 5 "directory-files-and-attributes with stat: %s"
localname)
+ (tramp-maybe-send-script
+ vec tramp-stat-directory-files-and-attributes
+ "tramp_stat_directory_files_and_attributes")
(tramp-send-command-and-read
- vec
- (format
- (concat
- ;; We must care about file names with spaces, or starting with
- ;; "-"; this would confuse xargs. "ls -aQ" might be a solution,
- ;; but it does not work on all remote systems. Therefore, we use
- ;; \000 as file separator. `tramp-sh--quoting-style-options' do
- ;; not work for file names with spaces piped to "xargs".
- ;; Apostrophes in the stat output are masked as
- ;; `tramp-stat-marker', in order to make a proper shell escape of
- ;; them in file names.
- "cd %s && echo \"(\"; (%s %s -a | tr '\\n\\r' '\\000\\000' | "
- "xargs -0 %s -c "
- "'(%s%%n%s (%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' "
- "-- 2>%s | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\"")
- (tramp-shell-quote-argument localname)
- (tramp-get-ls-command vec)
- ;; On systems which have no quoting style, file names with special
- ;; characters could fail.
- (tramp-sh--quoting-style-options vec)
- (tramp-get-remote-stat vec)
- tramp-stat-marker tramp-stat-marker
- tramp-stat-marker tramp-stat-marker
- (if (eq id-format 'integer)
- "%u"
- (eval-when-compile (concat tramp-stat-marker "%U" tramp-stat-marker)))
- (if (eq id-format 'integer)
- "%g"
- (eval-when-compile (concat tramp-stat-marker "%G" tramp-stat-marker)))
- tramp-stat-marker tramp-stat-marker
- (tramp-get-remote-null-device vec)
- tramp-stat-quoted-marker)))
+ vec (format "tramp_stat_directory_files_and_attributes %s"
+ (tramp-shell-quote-argument localname))))
;; This function should return "foo/" for directories and "bar" for
;; files.
(defun tramp-sh-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (unless (tramp-compat-string-search "/" filename)
- (all-completions
- filename
- (with-parsed-tramp-file-name (expand-file-name directory) nil
+ (with-parsed-tramp-file-name (expand-file-name directory) nil
+ (when (and (not (tramp-compat-string-search "/" filename))
+ (tramp-connectable-p v))
+ (all-completions
+ filename
(with-tramp-file-property v localname "file-name-all-completions"
(let (result)
;; Get a list of directories and files, including reliably
@@ -1790,7 +1876,7 @@ ID-FORMAT valid values are `string' and `integer'."
;; Check result code, found in last line of output.
(forward-line -1)
- (if (looking-at-p "^fail$")
+ (if (looking-at-p (rx bol "fail" eol))
(progn
;; Grab error message from line before last line
;; (it was put there by `cd 2>&1').
@@ -1798,12 +1884,12 @@ ID-FORMAT valid values are `string' and `integer'."
(tramp-error
v 'file-error
"tramp-sh-handle-file-name-all-completions: %s"
- (buffer-substring (point) (point-at-eol))))
+ (buffer-substring (point) (line-end-position))))
;; For peace of mind, if buffer doesn't end in `fail'
;; then it should end in `ok'. If neither are in the
;; buffer something went seriously wrong on the remote
;; side.
- (unless (looking-at-p "^ok$")
+ (unless (looking-at-p (rx bol "ok" eol))
(tramp-error
v 'file-error
(concat "tramp-sh-handle-file-name-all-completions: "
@@ -1811,7 +1897,7 @@ ID-FORMAT valid values are `string' and `integer'."
(tramp-shell-quote-argument localname) (buffer-string))))
(while (zerop (forward-line -1))
- (push (buffer-substring (point) (point-at-eol)) result)))
+ (push (buffer-substring (point) (line-end-position)) result)))
result))))))
;; cp, mv and ln
@@ -1826,8 +1912,8 @@ ID-FORMAT valid values are `string' and `integer'."
v 'file-error
"add-name-to-file: %s"
"only implemented for same method, same user, same host")))
- (with-parsed-tramp-file-name filename v1
- (with-parsed-tramp-file-name newname v2
+ (with-parsed-tramp-file-name (expand-file-name filename) v1
+ (with-parsed-tramp-file-name (expand-file-name newname) v2
(let ((ln (when v1 (tramp-get-remote-ln v1))))
;; Do the 'confirm if exists' thing.
@@ -1869,59 +1955,62 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-sh-handle-copy-directory
(dirname newname &optional keep-date parents copy-contents)
"Like `copy-directory' for Tramp files."
- (let ((t1 (tramp-tramp-file-p dirname))
- (t2 (tramp-tramp-file-p newname))
- target)
- (with-parsed-tramp-file-name (if t1 dirname newname) nil
- (unless (file-exists-p dirname)
- (tramp-compat-file-missing v dirname))
-
- ;; `copy-directory-create-symlink' exists since Emacs 28.1.
- (if (and (bound-and-true-p copy-directory-create-symlink)
- (setq target (file-symlink-p dirname))
- (tramp-equal-remote dirname newname))
- (make-symbolic-link
- target
- (if (directory-name-p newname)
- (concat newname (file-name-nondirectory dirname)) newname)
- t)
-
- (if (and (not copy-contents)
- (tramp-get-method-parameter v 'tramp-copy-recursive)
- ;; When DIRNAME and NEWNAME are remote, they must
- ;; have the same method.
- (or (null t1) (null t2)
- (string-equal
- (tramp-file-name-method (tramp-dissect-file-name dirname))
- (tramp-file-name-method
- (tramp-dissect-file-name newname)))))
- ;; scp or rsync DTRT.
- (progn
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-already-exists newname))
- (setq dirname (directory-file-name (expand-file-name dirname))
- newname (directory-file-name (expand-file-name newname)))
- (when (and (file-directory-p newname)
- (not (string-equal (file-name-nondirectory dirname)
- (file-name-nondirectory newname))))
- (setq newname
- (expand-file-name
- (file-name-nondirectory dirname) newname)))
- (unless (file-directory-p (file-name-directory newname))
- (make-directory (file-name-directory newname) parents))
- (tramp-do-copy-or-rename-file-out-of-band
- 'copy dirname newname 'ok-if-already-exists keep-date))
-
- ;; We must do it file-wise.
- (tramp-run-real-handler
- #'copy-directory
- (list dirname newname keep-date parents copy-contents))))
-
- ;; When newname did exist, we have wrong cached values.
- (when t2
- (with-parsed-tramp-file-name newname nil
- (tramp-flush-file-properties v localname))))))
+ (tramp-skeleton-copy-directory
+ dirname newname keep-date parents copy-contents
+ (let ((t1 (tramp-tramp-file-p dirname))
+ (t2 (tramp-tramp-file-p newname))
+ target)
+ (with-parsed-tramp-file-name (if t1 dirname newname) nil
+ (unless (file-exists-p dirname)
+ (tramp-error v 'file-missing dirname))
+
+ ;; `copy-directory-create-symlink' exists since Emacs 28.1.
+ (if (and (bound-and-true-p copy-directory-create-symlink)
+ (setq target (file-symlink-p dirname))
+ (tramp-equal-remote dirname newname))
+ (make-symbolic-link
+ target
+ (if (directory-name-p newname)
+ (concat newname (file-name-nondirectory dirname)) newname)
+ t)
+
+ (if (and (not copy-contents)
+ (tramp-get-method-parameter v 'tramp-copy-recursive)
+ ;; When DIRNAME and NEWNAME are remote, they must
+ ;; have the same method.
+ (or (null t1) (null t2)
+ (string-equal
+ (tramp-file-name-method
+ (tramp-dissect-file-name dirname))
+ (tramp-file-name-method
+ (tramp-dissect-file-name newname)))))
+ ;; scp or rsync DTRT.
+ (progn
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-already-exists newname))
+ (setq dirname (directory-file-name (expand-file-name dirname))
+ newname (directory-file-name (expand-file-name newname)))
+ (when (and (file-directory-p newname)
+ (not (string-equal (file-name-nondirectory dirname)
+ (file-name-nondirectory
newname))))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory dirname) newname)))
+ (unless (file-directory-p (file-name-directory newname))
+ (make-directory (file-name-directory newname) parents))
+ (tramp-do-copy-or-rename-file-out-of-band
+ 'copy dirname newname 'ok-if-already-exists keep-date))
+
+ ;; We must do it file-wise.
+ (tramp-run-real-handler
+ #'copy-directory
+ (list dirname newname keep-date parents copy-contents))))
+
+ ;; When newname did exist, we have wrong cached values.
+ (when t2
+ (with-parsed-tramp-file-name (expand-file-name newname) nil
+ (tramp-flush-file-properties v localname)))))))
(defun tramp-sh-handle-rename-file
(filename newname &optional ok-if-already-exists)
@@ -1956,6 +2045,7 @@ This function is invoked by `tramp-sh-handle-copy-file'
and
`tramp-sh-handle-rename-file'. It is an error if OP is neither
of `copy' and `rename'. FILENAME and NEWNAME must be absolute
file names."
+ ;; FILENAME and NEWNAME are already expanded.
(unless (memq op '(copy rename))
(error "Unknown operation `%s', must be `copy' or `rename'" op))
@@ -1966,98 +2056,101 @@ file names."
(copy-directory filename newname keep-date t)
(when (eq op 'rename) (delete-directory filename 'recursive)))
+ ;; FIXME: This should be optimized. Computing `file-attributes'
+ ;; checks already, whether the file exists.
(let ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname))
- (length (tramp-compat-file-attribute-size
+ (length (file-attribute-size
(file-attributes (file-truename filename))))
- (attributes (and preserve-extended-attributes
- (file-extended-attributes filename)))
(msg-operation (if (eq op 'copy) "Copying" "Renaming")))
(with-parsed-tramp-file-name (if t1 filename newname) nil
- (unless (file-exists-p filename)
- (tramp-compat-file-missing v filename))
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-error "File is a directory %s" newname))
+ (unless length
+ (tramp-error v 'file-missing filename))
+ (tramp-barf-if-file-missing v filename
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-error "File is a directory %s" newname))
- (with-tramp-progress-reporter
- v 0 (format "%s %s to %s" msg-operation filename newname)
+ (with-tramp-progress-reporter
+ v 0 (format "%s %s to %s" msg-operation filename newname)
- (cond
- ;; Both are Tramp files.
- ((and t1 t2)
- (with-parsed-tramp-file-name filename v1
- (with-parsed-tramp-file-name newname v2
- (cond
- ;; Shortcut: if method, host, user are the same for
- ;; both files, we invoke `cp' or `mv' on the remote
- ;; host directly.
- ((tramp-equal-remote filename newname)
- (tramp-do-copy-or-rename-file-directly
- op filename newname
- ok-if-already-exists keep-date preserve-uid-gid))
-
- ;; Try out-of-band operation.
- ((and
- (tramp-method-out-of-band-p v1 length)
- (tramp-method-out-of-band-p v2 length))
- (tramp-do-copy-or-rename-file-out-of-band
- op filename newname ok-if-already-exists keep-date))
-
- ;; No shortcut was possible. So we copy the file
- ;; first. If the operation was `rename', we go back
- ;; and delete the original file (if the copy was
- ;; successful). The approach is simple-minded: we
- ;; create a new buffer, insert the contents of the
- ;; source file into it, then write out the buffer to
- ;; the target file. The advantage is that it doesn't
- ;; matter which file name handlers are used for the
- ;; source and target file.
- (t
- (tramp-do-copy-or-rename-file-via-buffer
- op filename newname ok-if-already-exists keep-date))))))
-
- ;; One file is a Tramp file, the other one is local.
- ((or t1 t2)
(cond
- ;; Fast track on local machine.
- ((tramp-local-host-p v)
- (tramp-do-copy-or-rename-file-directly
- op filename newname
- ok-if-already-exists keep-date preserve-uid-gid))
-
- ;; If the Tramp file has an out-of-band method, the
- ;; corresponding copy-program can be invoked.
- ((tramp-method-out-of-band-p v length)
- (tramp-do-copy-or-rename-file-out-of-band
- op filename newname ok-if-already-exists keep-date))
-
- ;; Use the inline method via a Tramp buffer.
- (t (tramp-do-copy-or-rename-file-via-buffer
- op filename newname ok-if-already-exists keep-date))))
-
- (t
- ;; One of them must be a Tramp file.
- (error "Tramp implementation says this cannot happen")))
+ ;; Both are Tramp files.
+ ((and t1 t2)
+ (with-parsed-tramp-file-name filename v1
+ (with-parsed-tramp-file-name newname v2
+ (cond
+ ;; Shortcut: if method, host, user are the same for
+ ;; both files, we invoke `cp' or `mv' on the remote
+ ;; host directly.
+ ((tramp-equal-remote filename newname)
+ (tramp-do-copy-or-rename-file-directly
+ op filename newname
+ ok-if-already-exists keep-date preserve-uid-gid))
+
+ ;; Try out-of-band operation.
+ ((and
+ (tramp-method-out-of-band-p v1 length)
+ (tramp-method-out-of-band-p v2 length))
+ (tramp-do-copy-or-rename-file-out-of-band
+ op filename newname ok-if-already-exists keep-date))
+
+ ;; No shortcut was possible. So we copy the file
+ ;; first. If the operation was `rename', we go
+ ;; back and delete the original file (if the copy
+ ;; was successful). The approach is simple-minded:
+ ;; we create a new buffer, insert the contents of
+ ;; the source file into it, then write out the
+ ;; buffer to the target file. The advantage is
+ ;; that it doesn't matter which file name handlers
+ ;; are used for the source and target file.
+ (t
+ (tramp-do-copy-or-rename-file-via-buffer
+ op filename newname ok-if-already-exists keep-date))))))
+
+ ;; One file is a Tramp file, the other one is local.
+ ((or t1 t2)
+ (cond
+ ;; Fast track on local machine.
+ ((tramp-local-host-p v)
+ (tramp-do-copy-or-rename-file-directly
+ op filename newname
+ ok-if-already-exists keep-date preserve-uid-gid))
+
+ ;; If the Tramp file has an out-of-band method, the
+ ;; corresponding copy-program can be invoked.
+ ((tramp-method-out-of-band-p v length)
+ (tramp-do-copy-or-rename-file-out-of-band
+ op filename newname ok-if-already-exists keep-date))
+
+ ;; Use the inline method via a Tramp buffer.
+ (t (tramp-do-copy-or-rename-file-via-buffer
+ op filename newname ok-if-already-exists keep-date))))
- ;; Handle `preserve-extended-attributes'. We ignore possible
- ;; errors, because ACL strings could be incompatible.
- (when attributes
- (ignore-errors
- (set-file-extended-attributes newname attributes)))
+ (t
+ ;; One of them must be a Tramp file.
+ (error "Tramp implementation says this cannot happen")))
+
+ ;; Handle `preserve-extended-attributes'. We ignore
+ ;; possible errors, because ACL strings could be
+ ;; incompatible.
+ (when-let ((attributes (and preserve-extended-attributes
+ (file-extended-attributes filename))))
+ (ignore-errors
+ (set-file-extended-attributes newname attributes)))
- ;; In case of `rename', we must flush the cache of the source file.
- (when (and t1 (eq op 'rename))
- (with-parsed-tramp-file-name filename v1
- (tramp-flush-file-properties v1 v1-localname)))
+ ;; In case of `rename', we must flush the cache of the source file.
+ (when (and t1 (eq op 'rename))
+ (with-parsed-tramp-file-name filename v1
+ (tramp-flush-file-properties v1 v1-localname)))
- ;; When newname did exist, we have wrong cached values.
- (when t2
- (with-parsed-tramp-file-name newname v2
- (tramp-flush-file-properties v2 v2-localname))))))))
+ ;; When newname did exist, we have wrong cached values.
+ (when t2
+ (with-parsed-tramp-file-name newname v2
+ (tramp-flush-file-properties v2 v2-localname)))))))))
(defun tramp-do-copy-or-rename-file-via-buffer
(op filename newname ok-if-already-exists keep-date)
@@ -2065,10 +2158,11 @@ file names."
First arg OP is either `copy' or `rename' and indicates the operation.
FILENAME is the source file, NEWNAME the target file.
KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
+ ;; FILENAME and NEWNAME are already expanded.
;; Check, whether file is too large. Emacs checks in `insert-file-1'
;; and `find-file-noselect', but that's not called here.
(abort-if-file-too-large
- (tramp-compat-file-attribute-size (file-attributes (file-truename
filename)))
+ (file-attribute-size (file-attributes (file-truename filename)))
(symbol-name op) filename)
;; We must disable multibyte, because binary data shall not be
;; converted. We don't want the target file to be compressed, so we
@@ -2090,8 +2184,7 @@ KEEP-DATE is non-nil if NEWNAME should have the same
timestamp as FILENAME."
(when keep-date
(tramp-compat-set-file-times
newname
- (tramp-compat-file-attribute-modification-time
- (file-attributes filename))
+ (file-attribute-modification-time (file-attributes filename))
(unless ok-if-already-exists 'nofollow)))
;; Set the mode.
(set-file-modes newname (tramp-default-file-modes filename))
@@ -2108,9 +2201,10 @@ the file (for rename). Both files must reside on the
same host.
KEEP-DATE means to make sure that NEWNAME has the same timestamp
as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
the uid and gid from FILENAME."
+ ;; FILENAME and NEWNAME are already expanded.
(let ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname))
- (file-times (tramp-compat-file-attribute-modification-time
+ (file-times (file-attribute-modification-time
(file-attributes filename)))
(file-modes (tramp-default-file-modes filename)))
(with-parsed-tramp-file-name (if t1 filename newname) nil
@@ -2178,6 +2272,8 @@ the uid and gid from FILENAME."
(file-name-directory (concat prefix localname2)))
(or (file-directory-p (concat prefix localname2))
(file-writable-p (concat prefix localname2))))
+ (with-parsed-tramp-file-name prefix nil
+ (tramp-flush-file-properties v localname2))
(tramp-do-copy-or-rename-file-directly
op (concat prefix localname1) (concat prefix localname2)
ok-if-already-exists keep-date preserve-uid-gid)
@@ -2254,134 +2350,145 @@ the uid and gid from FILENAME."
(op filename newname ok-if-already-exists keep-date)
"Invoke `scp' program to copy.
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)))
+ ;; FILENAME and NEWNAME are already expanded.
+ (let* ((v1 (and (tramp-tramp-file-p filename)
+ (tramp-dissect-file-name filename)))
+ (v2 (and (tramp-tramp-file-p newname)
+ (tramp-dissect-file-name newname)))
+ (v (or v1 v2))
copy-program copy-args copy-env copy-keep-date listener spec
options source target remote-copy-program remote-copy-args p)
- (with-parsed-tramp-file-name (if t1 filename newname) nil
- (if (and t1 t2)
-
- ;; Both are Tramp files. We shall optimize it when the
- ;; methods for FILENAME and NEWNAME are the same.
- (let* ((dir-flag (file-directory-p filename))
- (tmpfile (tramp-compat-make-temp-file localname dir-flag)))
- (if dir-flag
- (setq tmpfile
- (expand-file-name
- (file-name-nondirectory newname) tmpfile)))
- (unwind-protect
- (progn
- (tramp-do-copy-or-rename-file-out-of-band
- op filename tmpfile ok-if-already-exists keep-date)
- (tramp-do-copy-or-rename-file-out-of-band
- 'rename tmpfile newname ok-if-already-exists keep-date))
- ;; Save exit.
- (ignore-errors
- (if dir-flag
- (delete-directory
- (expand-file-name ".." tmpfile) 'recursive)
- (delete-file tmpfile)))))
-
- ;; Check which ones of source and target are Tramp files.
- (setq source (funcall
- (if (and (string-equal method "rsync")
- (file-directory-p filename)
- (not (file-exists-p newname)))
- #'file-name-as-directory
- #'identity)
- (if t1
- (tramp-make-copy-program-file-name v)
- (tramp-compat-file-name-unquote filename)))
- target (if t2
- (tramp-make-copy-program-file-name v)
- (tramp-compat-file-name-unquote newname)))
-
- ;; 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)))
-
- ;; Check for listener port.
- (when (tramp-get-method-parameter v 'tramp-remote-copy-args)
- (setq listener (number-to-string (+ 50000 (random 10000))))
- (while
- (zerop (tramp-call-process v "nc" nil nil nil "-z" host listener))
- (setq listener (number-to-string (+ 50000 (random 10000))))))
-
- ;; Compose copy command.
- (setq options
- (format-spec
- (tramp-ssh-controlmaster-options v)
- (format-spec-make
- ?t (tramp-get-connection-property
- (tramp-get-connection-process v) "temp-file" "")))
- spec (list
- ?h (or host "") ?u (or user "") ?p (or port "")
- ?r listener ?c options ?k (if keep-date " " "")
- ?n (concat "2>" (tramp-get-remote-null-device v))
- ?x (tramp-scp-strict-file-name-checking v)
- ?y (tramp-scp-force-scp-protocol v))
- copy-program (tramp-get-method-parameter v 'tramp-copy-program)
- copy-keep-date (tramp-get-method-parameter
- v 'tramp-copy-keep-date)
- copy-args
- ;; " " has either been a replacement of "%k" (when
- ;; keep-date argument is non-nil), or a replacement for
- ;; the whole keep-date sublist.
- (delete " " (apply #'tramp-expand-args v 'tramp-copy-args spec))
- ;; `tramp-ssh-controlmaster-options' is a string instead
- ;; of a list. Unflatten it.
- copy-args
- (tramp-compat-flatten-tree
- (mapcar
- (lambda (x) (if (tramp-compat-string-search " " x)
- (split-string x) x))
- copy-args))
- copy-env (apply #'tramp-expand-args v 'tramp-copy-env spec)
- remote-copy-program
- (tramp-get-method-parameter v 'tramp-remote-copy-program)
- remote-copy-args
- (apply #'tramp-expand-args v 'tramp-remote-copy-args spec))
-
- ;; Check for local copy program.
- (unless (executable-find copy-program)
- (tramp-error
- v 'file-error "Cannot find local copy program: %s" copy-program))
-
- ;; Install listener on the remote side. The prompt must be
- ;; consumed later on, when the process does not listen anymore.
- (when remote-copy-program
- (unless (with-tramp-connection-property
- v (concat "remote-copy-program-" remote-copy-program)
- (tramp-find-executable
- v remote-copy-program (tramp-get-remote-path v)))
- (tramp-error
- v 'file-error
- "Cannot find remote listener: %s" remote-copy-program))
- (setq remote-copy-program
- (mapconcat
- #'identity
- (append
- (list remote-copy-program) remote-copy-args
- (list (if t1 (concat "<" source) (concat ">" target)) "&"))
- " "))
- (tramp-send-command v remote-copy-program)
- (with-timeout
- (60 (tramp-error
- v 'file-error
- "Listener process not running on remote host: `%s'"
- remote-copy-program))
- (tramp-send-command v (format "netstat -l | grep -q :%s" listener))
- (while (not (tramp-send-command-and-check v nil))
- (tramp-send-command
- v (format "netstat -l | grep -q :%s" listener)))))
+ (if (and v1 v2 (zerop (length (tramp-scp-direct-remote-copying v1 v2))))
- (with-temp-buffer
+ ;; Both are Tramp files. We cannot use direct remote copying.
+ (let* ((dir-flag (file-directory-p filename))
+ (tmpfile (tramp-compat-make-temp-file
+ (tramp-file-name-localname v1) dir-flag)))
+ (if dir-flag
+ (setq tmpfile
+ (expand-file-name
+ (file-name-nondirectory newname) tmpfile)))
(unwind-protect
+ (progn
+ (tramp-do-copy-or-rename-file-out-of-band
+ op filename tmpfile ok-if-already-exists keep-date)
+ (tramp-do-copy-or-rename-file-out-of-band
+ 'rename tmpfile newname ok-if-already-exists keep-date))
+ ;; Save exit.
+ (ignore-errors
+ (if dir-flag
+ (delete-directory
+ (expand-file-name ".." tmpfile) 'recursive)
+ (delete-file tmpfile)))))
+
+ ;; Check which ones of source and target are Tramp files.
+ (setq source (funcall
+ (if (and (string-equal (tramp-file-name-method v) "rsync")
+ (file-directory-p filename)
+ (not (file-exists-p newname)))
+ #'file-name-as-directory
+ #'identity)
+ (if v1
+ (tramp-make-copy-program-file-name v1)
+ (tramp-compat-file-name-unquote filename)))
+ target (if v2
+ (tramp-make-copy-program-file-name v2)
+ (tramp-compat-file-name-unquote newname)))
+
+ ;; Check for listener port.
+ (when (tramp-get-method-parameter v 'tramp-remote-copy-args)
+ (setq listener (number-to-string (+ 50000 (random 10000))))
+ (while
+ (zerop (tramp-call-process
+ v "nc" nil nil nil "-z" (tramp-file-name-host v) listener))
+ (setq listener (number-to-string (+ 50000 (random 10000))))))
+
+ ;; Compose copy command.
+ (setq options
+ (format-spec
+ (tramp-ssh-controlmaster-options v)
+ (format-spec-make
+ ?t (tramp-get-connection-property
+ (tramp-get-connection-process v) "temp-file" "")))
+ spec (list
+ ;; "%h" and "%u" do not happen in `tramp-copy-args'
+ ;; of `scp', so it is save to use `v'.
+ ?h (or (tramp-file-name-host v) "")
+ ?u (or (tramp-file-name-user v)
+ ;; There might be an interactive setting.
+ (tramp-get-connection-property v "login-as")
+ "")
+ ;; For direct remote copying, the port must be the
+ ;; same for source and target.
+ ?p (or (tramp-file-name-port v) "")
+ ?r listener ?c options ?k (if keep-date " " "")
+ ?n (concat "2>" (tramp-get-remote-null-device v))
+ ?x (tramp-scp-strict-file-name-checking v)
+ ?y (tramp-scp-force-scp-protocol v)
+ ?z (tramp-scp-direct-remote-copying v1 v2))
+ copy-program (tramp-get-method-parameter v 'tramp-copy-program)
+ copy-keep-date (tramp-get-method-parameter
+ v 'tramp-copy-keep-date)
+ copy-args
+ ;; " " has either been a replacement of "%k" (when
+ ;; keep-date argument is non-nil), or a replacement for
+ ;; the whole keep-date sublist.
+ (delete " " (apply #'tramp-expand-args v 'tramp-copy-args spec))
+ ;; `tramp-ssh-controlmaster-options' is a string instead
+ ;; of a list. Unflatten it.
+ copy-args
+ (tramp-compat-flatten-tree
+ (mapcar
+ (lambda (x) (if (tramp-compat-string-search " " x)
+ (split-string x) x))
+ copy-args))
+ copy-env (apply #'tramp-expand-args v 'tramp-copy-env spec)
+ remote-copy-program
+ (tramp-get-method-parameter v 'tramp-remote-copy-program)
+ remote-copy-args
+ (apply #'tramp-expand-args v 'tramp-remote-copy-args spec))
+
+ ;; Check for local copy program.
+ (unless (executable-find copy-program)
+ (tramp-error
+ v 'file-error "Cannot find local copy program: %s" copy-program))
+
+ ;; Install listener on the remote side. The prompt must be
+ ;; consumed later on, when the process does not listen anymore.
+ (when remote-copy-program
+ (unless (with-tramp-connection-property
+ v (concat "remote-copy-program-" remote-copy-program)
+ (tramp-find-executable
+ v remote-copy-program (tramp-get-remote-path v)))
+ (tramp-error
+ v 'file-error
+ "Cannot find remote listener: %s" remote-copy-program))
+ (setq remote-copy-program
+ (mapconcat
+ #'identity
+ (append
+ (list remote-copy-program) remote-copy-args
+ (list (if v1 (concat "<" source) (concat ">" target)) "&"))
+ " "))
+ (tramp-send-command v remote-copy-program)
+ (with-timeout
+ (60 (tramp-error
+ v 'file-error
+ "Listener process not running on remote host: `%s'"
+ remote-copy-program))
+ (tramp-send-command v (format "netstat -l | grep -q :%s" listener))
+ (while (not (tramp-send-command-and-check v nil))
+ (tramp-send-command
+ v (format "netstat -l | grep -q :%s" listener)))))
+
+ (with-temp-buffer
+ (unwind-protect
+ (with-tramp-saved-connection-properties
+ v '("process-name" "process-buffer")
;; The default directory must be remote.
(let ((default-directory
- (file-name-directory (if t1 filename newname)))
+ (file-name-directory (if v1 filename newname)))
(process-environment (copy-sequence process-environment)))
;; Set the transfer process properties.
(tramp-set-connection-property
@@ -2390,7 +2497,7 @@ The method used must be an out-of-band method."
v "process-buffer" (current-buffer))
(when copy-env
(tramp-message
- orig-vec 6 "%s=\"%s\""
+ v 6 "%s=\"%s\""
(car copy-env) (string-join (cdr copy-env) " "))
(setenv (car copy-env) (string-join (cdr copy-env) " ")))
(setq
@@ -2398,58 +2505,57 @@ The method used must be an out-of-band method."
(append
copy-args
(if remote-copy-program
- (list (if t1 (concat ">" target) (concat "<" source)))
+ (list (if v1 (concat ">" target) (concat "<" source)))
(list source target)))
;; Use an asynchronous process. By this, password
;; can be handled. We don't set a timeout, because
;; the copying of large files can last longer than 60
;; secs.
- p (let ((default-directory
tramp-compat-temporary-file-directory))
+ p (let ((default-directory
+ tramp-compat-temporary-file-directory))
(apply
#'start-process
(tramp-get-connection-name v)
(tramp-get-connection-buffer v)
copy-program copy-args)))
- (tramp-message orig-vec 6 "%s" (string-join (process-command p)
" "))
- (process-put p 'vector orig-vec)
+ (tramp-message v 6 "%s" (string-join (process-command p) " "))
+ (process-put p 'vector v)
(process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil)
- ;; We must adapt `tramp-local-end-of-line' for
- ;; sending the password.
- (let ((tramp-local-end-of-line tramp-rsh-end-of-line))
+ ;; We must adapt `tramp-local-end-of-line' for sending
+ ;; the password. Also, we indicate that perhaps
+ ;; several password prompts might appear.
+ (let ((tramp-local-end-of-line tramp-rsh-end-of-line)
+ (tramp-password-prompt-not-unique (and v1 v2)))
(tramp-process-actions
- p v nil tramp-actions-copy-out-of-band)))
-
- ;; Reset the transfer process properties.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")
- ;; Clear the remote prompt.
- (when (and remote-copy-program
- (not (tramp-send-command-and-check v nil)))
- ;; Houston, we have a problem! Likely, the listener is
- ;; still running, so let's clear everything (but the
- ;; cached password).
- (tramp-cleanup-connection v 'keep-debug 'keep-password))))
-
- ;; Handle KEEP-DATE argument.
- (when (and keep-date (not copy-keep-date))
- (tramp-compat-set-file-times
- newname
- (tramp-compat-file-attribute-modification-time
- (file-attributes filename))
- (unless ok-if-already-exists 'nofollow)))
-
- ;; Set the mode.
- (unless (and keep-date copy-keep-date)
- (ignore-errors
- (set-file-modes newname (tramp-default-file-modes filename)))))
-
- ;; If the operation was `rename', delete the original file.
- (unless (eq op 'copy)
- (if (file-regular-p filename)
- (delete-file filename)
- (delete-directory filename 'recursive))))))
+ p v nil tramp-actions-copy-out-of-band))))
+
+ ;; Clear the remote prompt.
+ (when (and remote-copy-program
+ (not (tramp-send-command-and-check v nil)))
+ ;; Houston, we have a problem! Likely, the listener is
+ ;; still running, so let's clear everything (but the
+ ;; cached password).
+ (tramp-cleanup-connection v 'keep-debug 'keep-password))))
+
+ ;; Handle KEEP-DATE argument.
+ (when (and keep-date (not copy-keep-date))
+ (tramp-compat-set-file-times
+ newname
+ (file-attribute-modification-time (file-attributes filename))
+ (unless ok-if-already-exists 'nofollow)))
+
+ ;; Set the mode.
+ (unless (and keep-date copy-keep-date)
+ (ignore-errors
+ (set-file-modes newname (tramp-default-file-modes filename)))))
+
+ ;; If the operation was `rename', delete the original file.
+ (unless (eq op 'copy)
+ (if (file-regular-p filename)
+ (delete-file filename)
+ (delete-directory filename 'recursive)))))
(defun tramp-sh-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
@@ -2480,55 +2586,71 @@ The method used must be an out-of-band method."
(defun tramp-sh-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files."
- (setq filename (expand-file-name filename))
+ (setq filename (expand-file-name (expand-file-name filename)))
(with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
(if (and delete-by-moving-to-trash trash)
(move-file-to-trash filename)
(tramp-barf-unless-okay
v (format "rm -f %s" (tramp-shell-quote-argument localname))
- "Couldn't delete %s" filename))))
+ "Couldn't delete %s" filename))
+ (tramp-flush-file-properties v localname)))
;; Dired.
(defun tramp-sh-handle-dired-compress-file (file)
"Like `dired-compress-file' for Tramp files."
- ;; Code stolen mainly from dired-aux.el.
- (with-parsed-tramp-file-name file nil
- (tramp-flush-file-properties v localname)
- (let ((suffixes dired-compress-file-suffixes)
- suffix)
- ;; See if any suffix rule matches this file name.
- (while suffixes
- (let (case-fold-search)
- (if (string-match-p (car (car suffixes)) localname)
- (setq suffix (car suffixes) suffixes nil))
- (setq suffixes (cdr suffixes))))
-
- (cond ((file-symlink-p file) nil)
- ((and suffix (nth 2 suffix))
- ;; We found an uncompression rule.
- (with-tramp-progress-reporter
- v 0 (format "Uncompressing %s" file)
- (when (tramp-send-command-and-check
- v (concat (nth 2 suffix) " "
- (tramp-shell-quote-argument localname)))
- (dired-remove-file file)
- (string-match (car suffix) file)
- (concat (substring file 0 (match-beginning 0))))))
- (t
- ;; We don't recognize the file as compressed, so compress it.
- ;; Try gzip.
- (with-tramp-progress-reporter v 0 (format "Compressing %s" file)
- (when (tramp-send-command-and-check
- v (concat "gzip -f "
- (tramp-shell-quote-argument localname)))
- (dired-remove-file file)
- (cond ((file-exists-p (concat file ".gz"))
- (concat file ".gz"))
- ((file-exists-p (concat file ".z"))
- (concat file ".z"))
- (t nil)))))))))
+ ;; Starting with Emacs 29.1, `dired-compress-file' is performed by
+ ;; default handler.
+ (if (>= emacs-major-version 29)
+ (tramp-run-real-handler #'dired-compress-file (list file))
+ ;; Code stolen mainly from dired-aux.el.
+ (with-parsed-tramp-file-name (expand-file-name file) nil
+ (tramp-flush-file-properties v localname)
+ (let ((suffixes dired-compress-file-suffixes)
+ suffix)
+ ;; See if any suffix rule matches this file name.
+ (while suffixes
+ (let (case-fold-search)
+ (if (string-match-p (car (car suffixes)) localname)
+ (setq suffix (car suffixes) suffixes nil))
+ (setq suffixes (cdr suffixes))))
+
+ (cond ((file-symlink-p file) nil)
+ ((and suffix (nth 2 suffix))
+ ;; We found an uncompression rule.
+ (with-tramp-progress-reporter
+ v 0 (format "Uncompressing %s" file)
+ (when (tramp-send-command-and-check
+ v (if (string-match-p (rx "%" (any "io")) (nth 2
suffix))
+ (replace-regexp-in-string
+ "%i" (tramp-shell-quote-argument localname)
+ (nth 2 suffix))
+ (concat (nth 2 suffix) " "
+ (tramp-shell-quote-argument localname))))
+ (unless (string-match-p "\\.tar\\.gz" file)
+ (dired-remove-file file))
+ (string-match (car suffix) file)
+ (concat (substring file 0 (match-beginning 0))))))
+ (t
+ ;; We don't recognize the file as compressed, so
+ ;; compress it. Try gzip.
+ (with-tramp-progress-reporter v 0 (format "Compressing %s" file)
+ (when (tramp-send-command-and-check
+ v (if (file-directory-p file)
+ (format "tar -cf - %s | gzip -c9 > %s.tar.gz"
+ (tramp-shell-quote-argument
+ (file-name-nondirectory localname))
+ (tramp-shell-quote-argument localname))
+ (concat "gzip -f "
+ (tramp-shell-quote-argument localname))))
+ (unless (file-directory-p file)
+ (dired-remove-file file))
+ (catch 'found nil
+ (dolist (target (mapcar (lambda (suffix)
+ (concat file suffix))
+ '(".tar.gz" ".gz" ".z")))
+ (when (file-exists-p target)
+ (throw 'found target))))))))))))
(defun tramp-sh-handle-insert-directory
(filename switches &optional wildcard full-directory-p)
@@ -2600,7 +2722,7 @@ The method used must be an out-of-band method."
;; We cannot use `insert-buffer-substring' because the Tramp
;; buffer changes its contents before insertion due to calling
;; `expand-file-name' and alike.
- (insert (with-current-buffer (tramp-get-buffer v) (buffer-string)))
+ (insert (tramp-get-buffer-string (tramp-get-buffer v)))
;; We must enable unibyte strings, because the "--dired"
;; output counts in bytes.
@@ -2608,7 +2730,9 @@ The method used must be an out-of-band method."
(save-restriction
(narrow-to-region beg-marker end-marker)
;; Check for "--dired" output.
- (when (re-search-backward "^//DIRED//\\s-+\\(.+\\)$" nil 'noerror)
+ (when (re-search-backward
+ (rx bol "//DIRED//" (+ blank) (group (+ nonl)) eol)
+ nil 'noerror)
(let ((beg (match-beginning 1))
(end (match-end 0)))
;; Now read the numeric positions of file names.
@@ -2680,7 +2804,7 @@ The method used must be an out-of-band method."
;; Try to insert the amount of free space.
(goto-char (point-min))
;; First find the line to put it on.
- (when (and (re-search-forward "^\\([[:space:]]*total\\)" nil t)
+ (when (and (re-search-forward (rx bol (group (* blank) "total")) nil
t)
;; Emacs 29.1 or later.
(not (fboundp 'dired--insert-disk-space)))
(when-let ((available (get-free-disk-space ".")))
@@ -2704,62 +2828,65 @@ the result will be a local, non-Tramp, file name."
;; Handle empty NAME.
(when (zerop (length name)) (setq name "."))
;; On MS Windows, some special file names are not returned properly
- ;; by `file-name-absolute-p'.
- (if (and (eq system-type 'windows-nt)
- (string-match-p
- (concat "^\\([[:alpha:]]:\\|" null-device "$\\)") name))
+ ;; by `file-name-absolute-p'. If `tramp-syntax' is `simplified',
+ ;; there could be the false positive "/:".
+ (if (or (and (eq system-type 'windows-nt)
+ (string-match-p
+ (tramp-compat-rx bol (| (: alpha ":") (: (literal null-device)
eol)))
+ name))
+ (and (not (tramp-tramp-file-p name))
+ (not (tramp-tramp-file-p dir))))
(tramp-run-real-handler #'expand-file-name (list name dir))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
(setq name (tramp-compat-file-name-concat dir name)))
- ;; If connection is not established yet, run the real handler.
- (if (not (tramp-connectable-p name))
- (tramp-run-real-handler #'expand-file-name (list name nil))
- ;; Dissect NAME.
- (with-parsed-tramp-file-name name nil
+ ;; Dissect NAME.
+ (with-parsed-tramp-file-name name nil
+ ;; If connection is not established yet, run the real handler.
+ (if (not (tramp-connectable-p v))
+ (tramp-run-real-handler #'expand-file-name (list name))
(unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
(setq localname (concat "~/" localname)))
;; Tilde expansion if necessary. This needs a shell which
;; groks tilde expansion! The function `tramp-find-shell' is
;; supposed to find such a shell on the remote host. Please
;; tell me about it when this doesn't work on your system.
- (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
+ (when (string-match
+ (tramp-compat-rx
+ bos "~" (group (* (not "/"))) (group (* nonl)) eos)
+ localname)
(let ((uname (match-string 1 localname))
- (fname (match-string 2 localname)))
+ (fname (match-string 2 localname))
+ hname)
;; We cannot simply apply "~/", because under sudo "~/" is
;; expanded to the local user home directory but to the
;; root home directory. On the other hand, using always
;; the default user name for tilde expansion is not
;; appropriate either, because ssh and companions might
;; use a user name from the config file.
- (when (and (string-equal uname "~")
- (string-match-p "\\`su\\(do\\)?\\'" method))
- (setq uname (concat uname user)))
- (setq uname
- (with-tramp-connection-property v uname
- (tramp-send-command
- v
- (format "cd %s && pwd" (tramp-shell-quote-argument uname)))
- (with-current-buffer (tramp-get-buffer v)
- (goto-char (point-min))
- (buffer-substring (point) (point-at-eol)))))
- (setq localname (concat uname fname))))
+ (when (and (zerop (length uname))
+ (string-match-p (rx bos "su" (? "do") eos) method))
+ (setq uname user))
+ (when (setq hname (tramp-get-home-directory v uname))
+ (setq localname (concat hname fname)))))
;; There might be a double slash, for example when "~/"
;; expands to "/". Remove this.
(while (string-match "//" localname)
(setq localname (replace-match "/" t t localname)))
;; Do not keep "/..".
- (when (string-match-p "^/\\.\\.?$" localname)
+ (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname)
(setq localname "/"))
- ;; No tilde characters in file name, do normal
- ;; `expand-file-name' (this does "/./" and "/../").
+ ;; Do normal `expand-file-name' (this does "/./" and "/../"),
+ ;; unless there are tilde characters in file name.
;; `default-directory' is bound, because on Windows there
;; would be problems with UNC shares or Cygwin mounts.
(let ((default-directory tramp-compat-temporary-file-directory))
(tramp-make-tramp-file-name
v (tramp-drop-volume-letter
- (tramp-run-real-handler
- #'expand-file-name (list localname)))))))))
+ (if (string-prefix-p "~" localname)
+ localname
+ (tramp-run-real-handler
+ #'expand-file-name (list localname))))))))))
;;; Remote commands:
@@ -2800,7 +2927,10 @@ implementation will be used."
(signal 'wrong-type-argument (list #'symbolp coding)))
(when (eq connection-type t)
(setq connection-type 'pty))
- (unless (memq connection-type '(nil pipe pty))
+ (unless (or (and (consp connection-type)
+ (memq (car connection-type) '(nil pipe pty))
+ (memq (cdr connection-type) '(nil pipe pty)))
+ (memq connection-type '(nil pipe pty)))
(signal 'wrong-type-argument (list #'symbolp connection-type)))
(unless (or (null filter) (eq filter t) (functionp filter))
(signal 'wrong-type-argument (list #'functionp filter)))
@@ -2825,6 +2955,7 @@ implementation will be used."
stderr (tramp-make-tramp-temp-name v)))))
(remote-tmpstderr
(and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
+ (orig-command command)
(program (car command))
(args (cdr command))
;; When PROGRAM matches "*sh", and the first arg is
@@ -2833,11 +2964,12 @@ implementation will be used."
;; command.
(heredoc (and (not (bufferp stderr))
(stringp program)
- (string-match-p "sh$" program)
+ (string-match-p (rx "sh" eol) program)
(= (length args) 2)
(string-equal "-c" (car args))
;; Don't if there is a quoted string.
- (not (string-match-p "'\\|\"" (cadr args)))
+ (not
+ (string-match-p (rx (any "'\"")) (cadr args)))
;; Check, that /dev/tty is usable.
(tramp-get-remote-dev-tty v)))
;; When PROGRAM is nil, we just provide a tty.
@@ -2855,7 +2987,7 @@ implementation will be used."
;; `shell'. We discard hops, if existing, that's why
;; we cannot use `file-remote-p'.
(prompt (format "PS1=%s %s"
- (tramp-make-tramp-file-name v nil 'nohop)
+ (tramp-make-tramp-file-name v)
tramp-initial-end-of-output))
;; We use as environment the difference to toplevel
;; `process-environment'.
@@ -2924,91 +3056,103 @@ implementation will be used."
(setq i (1+ i)
name1 (format "%s<%d>" name i)))
(setq name name1)
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name)
- (tramp-set-connection-property v "process-buffer" buffer)
- (with-current-buffer (tramp-get-connection-buffer v)
- (unwind-protect
- ;; We catch this event. Otherwise, `make-process'
- ;; could be called on the local host.
- (save-excursion
- (save-restriction
- ;; Activate narrowing in order to save BUFFER
- ;; contents. Clear also the modification time;
- ;; otherwise we might be interrupted by
- ;; `verify-visited-file-modtime'.
- (let ((buffer-undo-list t)
- (inhibit-read-only t)
- (mark (point-max))
- (coding-system-for-write
- (if (symbolp coding) coding (car coding)))
- (coding-system-for-read
- (if (symbolp coding) coding (cdr coding))))
- (clear-visited-file-modtime)
- (narrow-to-region (point-max) (point-max))
- (catch 'suppress
- ;; Set the pid of the remote shell. This is
- ;; needed when sending signals remotely.
- (let ((pid (tramp-send-command-and-read v "echo $$")))
- (setq p (tramp-get-connection-process v))
- (process-put p 'remote-pid pid)
- (tramp-set-connection-property p "remote-pid" pid))
- ;; Disable carriage return to newline
- ;; translation. This does not work on
- ;; macOS, see Bug#50748.
- (when (and (memq connection-type '(nil pipe))
- (not (tramp-check-remote-uname v
"Darwin")))
- (tramp-send-command v "stty -icrnl"))
- ;; `tramp-maybe-open-connection' and
- ;; `tramp-send-command-and-read' could have
- ;; trashed the connection buffer. Remove this.
- (widen)
- (delete-region mark (point-max))
+ (with-tramp-saved-connection-properties
+ v '("process-name" "process-buffer")
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name)
+ (tramp-set-connection-property v "process-buffer" buffer)
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (unwind-protect
+ ;; We catch this event. Otherwise, `make-process'
+ ;; could be called on the local host.
+ (save-excursion
+ (save-restriction
+ ;; Activate narrowing in order to save BUFFER
+ ;; contents. Clear also the modification
+ ;; time; otherwise we might be interrupted by
+ ;; `verify-visited-file-modtime'.
+ (let ((buffer-undo-list t)
+ (inhibit-read-only t)
+ (mark (point-max))
+ (coding-system-for-write
+ (if (symbolp coding) coding (car coding)))
+ (coding-system-for-read
+ (if (symbolp coding) coding (cdr coding))))
+ (clear-visited-file-modtime)
(narrow-to-region (point-max) (point-max))
- ;; Now do it.
- (if command
- ;; Send the command.
- (tramp-send-command v command nil t) ; nooutput
- ;; Check, whether a pty is associated.
- (unless (process-get p 'remote-tty)
- (tramp-error
- v 'file-error
- "pty association is not supported for `%s'"
- name))))
- ;; Set sentinel and filter.
- (when sentinel
- (set-process-sentinel p sentinel))
- (when filter
- (set-process-filter p filter))
- ;; Set query flag and process marker for this
- ;; process. We ignore errors, because the
- ;; process could have finished already.
- (ignore-errors
- (set-process-query-on-exit-flag p (null noquery))
- (set-marker (process-mark p) (point)))
- ;; Kill stderr process and delete named pipe.
- (when (bufferp stderr)
- (add-function
- :after (process-sentinel p)
- (lambda (_proc _msg)
- (ignore-errors
- (while (accept-process-output
- (get-buffer-process stderr) 0 nil t))
- (delete-process (get-buffer-process stderr)))
- (ignore-errors
- (delete-file remote-tmpstderr)))))
- ;; Return process.
- p)))
-
- ;; Save exit.
- (if (string-prefix-p tramp-temp-buffer-name (buffer-name))
- (ignore-errors
- (set-process-buffer p nil)
- (kill-buffer (current-buffer)))
- (set-buffer-modified-p bmp))
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")))))))))
+ (catch 'suppress
+ ;; Set the pid of the remote shell. This
+ ;; is needed when sending signals
+ ;; remotely.
+ (let ((pid
+ (tramp-send-command-and-read v "echo $$")))
+ (setq p (tramp-get-connection-process v))
+ (process-put p 'remote-pid pid)
+ (tramp-set-connection-property
+ p "remote-pid" pid))
+ ;; Disable carriage return to newline
+ ;; translation. This does not work on
+ ;; macOS, see Bug#50748.
+ (when (and (memq connection-type '(nil pipe))
+ (not
+ (tramp-check-remote-uname v "Darwin")))
+ (tramp-send-command v "stty -icrnl"))
+ ;; `tramp-maybe-open-connection' and
+ ;; `tramp-send-command-and-read' could
+ ;; have trashed the connection buffer.
+ ;; Remove this.
+ (widen)
+ (delete-region mark (point-max))
+ (narrow-to-region (point-max) (point-max))
+ ;; Now do it.
+ (if command
+ ;; Send the command.
+ (tramp-send-command v command nil t) ; nooutput
+ ;; Check, whether a pty is associated.
+ (unless (process-get p 'remote-tty)
+ (tramp-error
+ v 'file-error
+ "pty association is not supported for `%s'"
+ name))))
+ ;; Set sentinel and filter.
+ (when sentinel
+ (set-process-sentinel p sentinel))
+ (when filter
+ (set-process-filter p filter))
+ (process-put p 'remote-command orig-command)
+ (tramp-set-connection-property
+ p "remote-command" orig-command)
+ ;; Set query flag and process marker for
+ ;; this process. We ignore errors, because
+ ;; the process could have finished already.
+ (ignore-errors
+ (set-process-query-on-exit-flag p (null noquery))
+ (set-marker (process-mark p) (point)))
+ ;; We must flush them here already;
+ ;; otherwise `delete-file' will fail.
+ (tramp-flush-connection-property v "process-name")
+ (tramp-flush-connection-property v "process-buffer")
+ ;; Kill stderr process and delete named pipe.
+ (when (bufferp stderr)
+ (add-function
+ :after (process-sentinel p)
+ (lambda (_proc _msg)
+ (ignore-errors
+ (while (accept-process-output
+ (get-buffer-process stderr) 0 nil t))
+ (delete-process (get-buffer-process stderr)))
+ (ignore-errors
+ (delete-file remote-tmpstderr)))))
+ ;; Return process.
+ p)))
+
+ ;; Save exit.
+ (if (string-prefix-p tramp-temp-buffer-name (buffer-name))
+ (ignore-errors
+ (set-process-buffer p nil)
+ (kill-buffer (current-buffer)))
+ (set-buffer-modified-p bmp)))))))))))
(defun tramp-sh-get-signal-strings (vec)
"Strings to return by `process-file' in case of signals."
@@ -3016,7 +3160,7 @@ implementation will be used."
vec
(concat
"signal-strings-" (tramp-get-method-parameter vec 'tramp-remote-shell))
- (let ((default-directory (tramp-make-tramp-file-name vec 'localname))
+ (let ((default-directory (tramp-make-tramp-file-name vec 'noloc))
process-file-return-signal-string signals res result)
(setq signals
(append
@@ -3030,7 +3174,7 @@ implementation will be used."
(let (signal-hook-function)
(condition-case nil
(dolist (sig (cdr signals))
- (unless (string-match-p "^[[:alnum:]+-]+$" sig)
+ (unless (string-match-p (rx bol (+ (any "+-" alnum)) eol) sig)
(error nil)))
(error (setq signals '(0)))))
(dotimes (i 128)
@@ -3038,7 +3182,7 @@ implementation will be used."
(cond
;; Some predefined values, which aren't reported sometimes,
;; or would raise problems (all Stopped signals).
- ((= i 0) 0)
+ ((zerop i) 0)
((string-equal (nth i signals) "HUP") "Hangup")
((string-equal (nth i signals) "INT") "Interrupt")
((string-equal (nth i signals) "QUIT") "Quit")
@@ -3061,8 +3205,9 @@ implementation will be used."
(tramp-shell-quote-argument (format "kill -%d $$" i))))
(with-current-buffer (tramp-get-connection-buffer vec)
(goto-char (point-min))
- (buffer-substring (point-at-bol) (point-at-eol)))))
- (if (string-equal res "")
+ (buffer-substring (line-beginning-position)
+ (line-end-position)))))
+ (if (string-empty-p res)
(format "Signal %d" i)
res)))
result))
@@ -3107,7 +3252,7 @@ implementation will be used."
(setq input (tramp-unquote-file-local-name infile))
;; INFILE must be copied to remote host.
(setq input (tramp-make-tramp-temp-file v)
- tmpinput (tramp-make-tramp-file-name v input 'nohop))
+ tmpinput (tramp-make-tramp-file-name v input))
(copy-file infile tmpinput t)))
(when input (setq command (format "%s <%s" command input)))
@@ -3139,7 +3284,7 @@ implementation will be used."
;; stderr must be copied to remote host. The temporary
;; file must be deleted after execution.
(setq stderr (tramp-make-tramp-temp-file v)
- tmpstderr (tramp-make-tramp-file-name v stderr 'nohop))))
+ tmpstderr (tramp-make-tramp-file-name v stderr))))
;; stderr to be discarded.
((null (cadr destination))
(setq stderr (tramp-get-remote-null-device v)))))
@@ -3164,8 +3309,7 @@ implementation will be used."
(when outbuf
(with-current-buffer outbuf
(insert
- (with-current-buffer (tramp-get-connection-buffer v)
- (buffer-string))))
+ (tramp-get-buffer-string (tramp-get-connection-buffer v))))
(when (and display (get-buffer-window outbuf t)) (redisplay))))
;; When the user did interrupt, we should do it also. We use
;; return code -1 as marker.
@@ -3190,7 +3334,7 @@ implementation will be used."
;; because the remote process could have changed them.
(when tmpinput (delete-file tmpinput))
(when process-file-side-effects
- (tramp-flush-directory-properties v ""))
+ (tramp-flush-directory-properties v "/"))
;; Return exit status.
(if (equal ret -1)
@@ -3206,119 +3350,109 @@ implementation will be used."
(defun tramp-sh-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (unless (file-exists-p (file-truename filename))
- (tramp-compat-file-missing v filename))
-
- (let* ((size (tramp-compat-file-attribute-size
- (file-attributes (file-truename filename))))
- (rem-enc (tramp-get-inline-coding v "remote-encoding" size))
- (loc-dec (tramp-get-inline-coding v "local-decoding" size))
- (tmpfile (tramp-compat-make-temp-file filename)))
+ (tramp-skeleton-file-local-copy filename
+ (if-let ((size (file-attribute-size (file-attributes filename))))
+ (let (rem-enc loc-dec)
- (condition-case err
- (cond
- ;; `copy-file' handles direct copy and out-of-band methods.
- ((or (tramp-local-host-p v)
- (tramp-method-out-of-band-p v size))
- (copy-file filename tmpfile 'ok-if-already-exists 'keep-time))
+ (condition-case err
+ (cond
+ ;; Empty file. Nothing to copy.
+ ((zerop size))
+
+ ;; `copy-file' handles direct copy and out-of-band methods.
+ ((or (tramp-local-host-p v)
+ (tramp-method-out-of-band-p v size))
+ (copy-file filename tmpfile 'ok-if-already-exists 'keep-time))
+
+ ;; Use inline encoding for file transfer.
+ ((and (setq rem-enc
+ (tramp-get-inline-coding v "remote-encoding" size))
+ (setq loc-dec
+ (tramp-get-inline-coding v "local-decoding" size)))
+ (with-tramp-progress-reporter
+ v 3
+ (format-message
+ "Encoding remote file `%s' with `%s'" filename rem-enc)
+ (tramp-barf-unless-okay
+ v (format rem-enc (tramp-shell-quote-argument localname))
+ "Encoding remote file failed"))
+
+ ;; Check error. `rem-enc' could be a pipe, which
+ ;; doesn't flag the error in the first command.
+ (when (zerop (buffer-size (tramp-get-buffer v)))
+ (tramp-error v 'file-error' "Encoding remote file failed"))
+
+ (with-tramp-progress-reporter
+ v 3 (format-message
+ "Decoding local file `%s' with `%s'" tmpfile loc-dec)
+ (if (functionp loc-dec)
+ ;; If local decoding is a function, we call it.
+ ;; We must disable multibyte, because
+ ;; `uudecode-decode-region' doesn't handle it
+ ;; correctly. Unset `file-name-handler-alist'.
+ ;; Otherwise, epa-file gets confused.
+ (let (file-name-handler-alist
+ (coding-system-for-write 'binary)
+ (default-directory
+ tramp-compat-temporary-file-directory))
+ (with-temp-file tmpfile
+ (set-buffer-multibyte nil)
+ (insert-buffer-substring (tramp-get-buffer v))
+ (funcall loc-dec (point-min) (point-max))))
+
+ ;; If tramp-decoding-function is not defined for
+ ;; this method, we invoke tramp-decoding-command
+ ;; instead.
+ (let ((tmpfile2 (tramp-compat-make-temp-file filename)))
+ ;; Unset `file-name-handler-alist'. Otherwise,
+ ;; epa-file gets confused.
+ (let (file-name-handler-alist
+ (coding-system-for-write 'binary))
+ (with-current-buffer (tramp-get-buffer v)
+ (write-region
+ (point-min) (point-max) tmpfile2 nil 'no-message)))
+ (unwind-protect
+ (tramp-call-local-coding-command
+ loc-dec tmpfile2 tmpfile)
+ (delete-file tmpfile2)))))
+
+ ;; Set proper permissions.
+ (set-file-modes tmpfile (tramp-default-file-modes filename))
+ ;; Set local user ownership.
+ (tramp-set-file-uid-gid tmpfile))
+
+ ;; Oops, I don't know what to do.
+ (t (tramp-error
+ v 'file-error "Wrong method specification for `%s'" method)))
- ;; Use inline encoding for file transfer.
- (rem-enc
- (with-tramp-progress-reporter
- v 3
- (format-message
- "Encoding remote file `%s' with `%s'" filename rem-enc)
- (tramp-barf-unless-okay
- v (format rem-enc (tramp-shell-quote-argument localname))
- "Encoding remote file failed"))
+ ;; Error handling.
+ ((error quit)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err)))))
- (with-tramp-progress-reporter
- v 3 (format-message
- "Decoding local file `%s' with `%s'" tmpfile loc-dec)
- (if (functionp loc-dec)
- ;; If local decoding is a function, we call it. We
- ;; must disable multibyte, because
- ;; `uudecode-decode-region' doesn't handle it
- ;; correctly. Unset `file-name-handler-alist'.
- ;; Otherwise, epa-file gets confused.
- (let (file-name-handler-alist
- (coding-system-for-write 'binary)
- (default-directory
- tramp-compat-temporary-file-directory))
- (with-temp-file tmpfile
- (set-buffer-multibyte nil)
- (insert-buffer-substring (tramp-get-buffer v))
- (funcall loc-dec (point-min) (point-max))))
-
- ;; If tramp-decoding-function is not defined for this
- ;; method, we invoke tramp-decoding-command instead.
- (let ((tmpfile2 (tramp-compat-make-temp-file filename)))
- ;; Unset `file-name-handler-alist'. Otherwise,
- ;; epa-file gets confused.
- (let (file-name-handler-alist
- (coding-system-for-write 'binary))
- (with-current-buffer (tramp-get-buffer v)
- (write-region
- (point-min) (point-max) tmpfile2 nil 'no-message)))
- (unwind-protect
- (tramp-call-local-coding-command
- loc-dec tmpfile2 tmpfile)
- (delete-file tmpfile2)))))
-
- ;; Set proper permissions.
- (set-file-modes tmpfile (tramp-default-file-modes filename))
- ;; Set local user ownership.
- (tramp-set-file-uid-gid tmpfile))
-
- ;; Oops, I don't know what to do.
- (t (tramp-error
- v 'file-error "Wrong method specification for `%s'" method)))
-
- ;; Error handling.
- ((error quit)
- (delete-file tmpfile)
- (signal (car err) (cdr err))))
-
- (run-hooks 'tramp-handle-file-local-copy-hook)
- tmpfile)))
+ ;; Impossible to copy. Trigger `file-missing' error.
+ (delete-file tmpfile)
+ (setq tmpfile nil))))
(defun tramp-sh-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename)
- lockname (file-truename (or lockname filename)))
- (with-parsed-tramp-file-name filename nil
- (when (and mustbenew (file-exists-p filename)
- (or (eq mustbenew 'excl)
- (not
- (y-or-n-p
- (format "File %s exists; overwrite anyway?" filename)))))
- (tramp-error v 'file-already-exists filename))
-
- (let ((file-locked (eq (file-locked-p lockname) t))
- (uid (or (tramp-compat-file-attribute-user-id
- (file-attributes filename 'integer))
- (tramp-get-remote-uid v 'integer)))
- (gid (or (tramp-compat-file-attribute-group-id
- (file-attributes filename 'integer))
- (tramp-get-remote-gid v 'integer))))
-
- ;; Lock file.
- (when (and (not (auto-save-file-name-p (file-name-nondirectory
filename)))
- (file-remote-p lockname)
- (not file-locked))
- (setq file-locked t)
- ;; `lock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'lock-file lockname))
+ (tramp-skeleton-write-region start end filename append visit lockname
mustbenew
+ ;; If `start' is the empty string, it is likely that a temporary
+ ;; file is created. Do it directly.
+ (if (and (stringp start) (string-empty-p start))
+ (tramp-send-command
+ v (format "cat <%s >%s"
+ (tramp-get-remote-null-device v)
+ (tramp-shell-quote-argument localname)))
+ ;; Short track: if we are on the local host, we can run directly.
(if (and (tramp-local-host-p v)
;; `file-writable-p' calls `file-expand-file-name'. We
;; cannot use `tramp-run-real-handler' therefore.
(file-writable-p (file-name-directory localname))
(or (file-directory-p localname)
(file-writable-p localname)))
- ;; Short track: if we are on the local host, we can run directly.
(let ((create-lockfiles (not file-locked)))
(write-region start end localname append 'no-message lockname))
@@ -3336,9 +3470,11 @@ implementation will be used."
;; Write region into a tmp file. This isn't really
;; needed if we use an encoding function, but currently
;; we use it always because this makes the logic
- ;; simpler. We must also set `temporary-file-directory',
- ;; because it could point to a remote directory.
- (temporary-file-directory tramp-compat-temporary-file-directory)
+ ;; simpler. We must also set
+ ;; `temporary-file-directory', because it could point
+ ;; to a remote directory.
+ (temporary-file-directory
+ tramp-compat-temporary-file-directory)
(tmpfile (or tramp-temp-buffer-file-name
(tramp-compat-make-temp-file filename))))
@@ -3354,7 +3490,7 @@ implementation will be used."
;; matches `tmpfile'.
(let ((file-coding-system-alist
(tramp-find-file-name-coding-system-alist filename tmpfile))
- create-lockfiles)
+ create-lockfiles)
(condition-case err
(write-region start end tmpfile append 'no-message)
((error quit)
@@ -3362,14 +3498,14 @@ implementation will be used."
(delete-file tmpfile)
(signal (car err) (cdr err))))
- ;; Now, `last-coding-system-used' has the right value. Remember it.
+ ;; Now, `last-coding-system-used' has the right value.
+ ;; Remember it.
(setq coding-system-used last-coding-system-used))
;; The permissions of the temporary file should be set. If
;; FILENAME does not exist (eq modes nil) it has been
;; renamed to the backup file. This case `save-buffer'
- ;; handles permissions.
- ;; Ensure that it is still readable.
+ ;; handles permissions. Ensure that it is still readable.
(when modes
(set-file-modes tmpfile (logior (or modes 0) #o0400)))
@@ -3380,8 +3516,7 @@ implementation will be used."
;; specified. However, if the method _also_ specifies an
;; encoding function, then that is used for encoding the
;; contents of the tmp file.
- (let* ((size (tramp-compat-file-attribute-size
- (file-attributes tmpfile)))
+ (let* ((size (file-attribute-size (file-attributes tmpfile)))
(rem-dec (tramp-get-inline-coding v "remote-decoding" size))
(loc-enc (tramp-get-inline-coding v "local-encoding" size)))
(cond
@@ -3391,7 +3526,8 @@ implementation will be used."
(if (and (not (stringp start))
(= (or end (point-max)) (point-max))
(= (or start (point-min)) (point-min))
- (tramp-get-method-parameter v 'tramp-copy-keep-tmpfile))
+ (tramp-get-method-parameter
+ v 'tramp-copy-keep-tmpfile))
(progn
(setq tramp-temp-buffer-file-name tmpfile)
(condition-case err
@@ -3431,7 +3567,7 @@ implementation will be used."
;; question is a tmp file anyway.
(let ((coding-system-for-read 'binary)
(default-directory
- tramp-compat-temporary-file-directory))
+ tramp-compat-temporary-file-directory))
(insert-file-contents-literally tmpfile)
(funcall loc-enc (point-min) (point-max)))
@@ -3452,21 +3588,19 @@ implementation will be used."
filename rem-dec)
(goto-char (point-max))
(unless (bolp) (newline))
- (tramp-send-command
- v
- (format
- (concat rem-dec " <<'%s'\n%s%s")
- (tramp-shell-quote-argument localname)
- tramp-end-of-heredoc
- (buffer-string)
- tramp-end-of-heredoc))
(tramp-barf-unless-okay
- v nil
+ v (format
+ (concat rem-dec " <<'%s'\n%s%s")
+ (tramp-shell-quote-argument localname)
+ tramp-end-of-heredoc
+ (buffer-string)
+ tramp-end-of-heredoc)
"Couldn't write region to `%s', decode using `%s' failed"
filename rem-dec)
- ;; When `file-precious-flag' is set, the region is
- ;; written to a temporary file. Check that the
- ;; checksum is equal to that from the local tmpfile.
+ ;; When `file-precious-flag' is set, the region
+ ;; is written to a temporary file. Check that
+ ;; the checksum is equal to that from the local
+ ;; tmpfile.
(when file-precious-flag
(erase-buffer)
(and
@@ -3474,15 +3608,13 @@ implementation will be used."
(zerop (tramp-call-process v "cksum" tmpfile t))
;; cksum runs remotely.
(tramp-send-command-and-check
- v
- (format
- "cksum <%s" (tramp-shell-quote-argument localname)))
+ v (format
+ "cksum <%s" (tramp-shell-quote-argument
localname)))
;; ... they are different.
(not
(string-equal
(buffer-string)
- (with-current-buffer (tramp-get-buffer v)
- (buffer-string))))
+ (tramp-get-buffer-string (tramp-get-buffer v))))
(tramp-error
v 'file-error
(concat "Couldn't write region to `%s',"
@@ -3502,39 +3634,7 @@ implementation will be used."
;; Make `last-coding-system-used' have the right value.
(when coding-system-used
- (setq last-coding-system-used coding-system-used))))
-
- (tramp-flush-file-properties v localname)
-
- ;; We must protect `last-coding-system-used', now we have set it
- ;; to its correct value.
- (let (last-coding-system-used (need-chown t))
- ;; Set file modification time.
- (when (or (eq visit t) (stringp visit))
- (let ((file-attr (file-attributes filename 'integer)))
- (set-visited-file-modtime
- ;; We must pass modtime explicitly, because FILENAME can
- ;; be different from (buffer-file-name), f.e. if
- ;; `file-precious-flag' is set.
- (or (tramp-compat-file-attribute-modification-time file-attr)
- (current-time)))
- (when (and (= (tramp-compat-file-attribute-user-id file-attr) uid)
- (= (tramp-compat-file-attribute-group-id file-attr)
gid))
- (setq need-chown nil))))
-
- ;; Set the ownership.
- (when need-chown
- (tramp-set-file-uid-gid filename uid gid))
-
- ;; Unlock file.
- (when file-locked
- ;; `unlock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'unlock-file lockname))
-
- (when (and (null noninteractive)
- (or (eq visit t) (string-or-null-p visit)))
- (tramp-message v 0 "Wrote %s" filename))
- (run-hooks 'tramp-handle-write-region-hook)))))
+ (setq last-coding-system-used coding-system-used)))))))
(defvar tramp-vc-registered-file-names nil
"List used to collect file names, which are checked during `vc-registered'.")
@@ -3658,8 +3758,7 @@ Fall back to normal file name handler if no Tramp handler
exists."
(defun tramp-sh-file-name-handler-p (vec)
"Whether VEC uses a method from `tramp-sh-file-name-handler'."
(and (assoc (tramp-file-name-method vec) tramp-methods)
- (eq (tramp-find-foreign-file-name-handler
- (tramp-make-tramp-file-name vec nil 'nohop))
+ (eq (tramp-find-foreign-file-name-handler vec)
'tramp-sh-file-name-handler)))
;; This must be the last entry, because `identity' always matches.
@@ -3720,6 +3819,7 @@ Fall back to normal file name handler if no Tramp handler
exists."
(concat "create,modify,move,moved_from,moved_to,move_self,"
"delete,delete_self,ignored"))
((memq 'attribute-change flags) "attrib,ignored"))
+ ;; "-P" has been added to version 3.21, so we cannot assume it
yet.
sequence `(,command "-mq" "-e" ,events ,localname)
;; Make events a list of symbols.
events
@@ -3776,8 +3876,7 @@ Fall back to normal file name handler if no Tramp handler
exists."
"Read output from \"gio monitor\" and add corresponding `file-notify'
events."
(let ((events (process-get proc 'events))
(remote-prefix
- (with-current-buffer (process-buffer proc)
- (file-remote-p default-directory)))
+ (file-remote-p (tramp-get-default-directory (process-buffer proc))))
(rest-string (process-get proc 'rest-string))
pos)
(when rest-string
@@ -3794,8 +3893,8 @@ Fall back to normal file name handler if no Tramp handler
exists."
(catch 'doesnt-work
;; https://bugs.launchpad.net/bugs/1742946
- (when
- (string-match-p "Monitoring not supported\\|No locations given"
string)
+ (when (string-match-p
+ (rx (| "Monitoring not supported" "No locations given")) string)
(delete-process proc)
(throw 'doesnt-work nil))
@@ -3811,12 +3910,13 @@ Fall back to normal file name handler if no Tramp
handler exists."
(setq pos (match-end 0))
(cond
((getenv "EMACS_EMBA_CI") 'GInotifyFileMonitor)
- ((eq system-type 'cygwin) 'GPollFileMonitor)
- (t nil)))
+ ((eq system-type 'cygwin) 'GPollFileMonitor)))
;; TODO: What happens, if several monitor names are reported?
- ((string-match "\
-Supported arguments for GIO_USE_FILE_MONITOR environment variable:
-\\s-*\\([[:alpha:]]+\\) - 20" string)
+ ((string-match
+ (rx "Supported arguments for "
+ "GIO_USE_FILE_MONITOR environment variable:\n"
+ (* blank) (group (+ alpha)) " - 20")
+ string)
(setq pos (match-end 0))
(intern
(format "G%sFileMonitor" (capitalize (match-string 1 string)))))
@@ -3827,15 +3927,15 @@ Supported arguments for GIO_USE_FILE_MONITOR
environment variable:
(setq string (tramp-compat-string-replace "\n\n" "\n" string))
(while (string-match
- (eval-when-compile
- (concat "^[^:]+:"
- "[[:space:]]\\([^:]+\\):"
- "[[:space:]]" (regexp-opt tramp-gio-events t)
- "\\([[:space:]]\\([^:]+\\)\\)?$"))
+ (tramp-compat-rx
+ bol (+ (not ":")) ":" blank
+ (group (+ (not ":"))) ":" blank
+ (group (regexp (regexp-opt tramp-gio-events)))
+ (? blank (group (+ (not ":")))) eol)
string)
(let* ((file (match-string 1 string))
- (file1 (match-string 4 string))
+ (file1 (match-string 3 string))
(object
(list
proc
@@ -3855,7 +3955,7 @@ Supported arguments for GIO_USE_FILE_MONITOR environment
variable:
`(file-notify ,object file-notify-callback))))))
;; Save rest of the string.
- (while (string-match "^\n" string)
+ (while (string-match (rx bol "\n") string)
(setq string (replace-match "" nil nil string)))
(when (zerop (length string)) (setq string nil))
(when string (tramp-message proc 10 "Rest string:\n%s" string))
@@ -3868,9 +3968,8 @@ Supported arguments for GIO_USE_FILE_MONITOR environment
variable:
(dolist (line (split-string string "[\n\r]+" 'omit))
;; Check, whether there is a problem.
(unless (string-match
- (concat "^[^[:blank:]]+"
- "[[:blank:]]+\\([^[:blank:]]+\\)"
- "\\([[:blank:]]+\\([^\n\r]+\\)\\)?")
+ (rx bol (+ (not blank)) (+ blank) (group (+ (not blank)))
+ (? (+ blank) (group (+ (not (any "\r\n"))))))
line)
(tramp-error proc 'file-notify-error line))
@@ -3882,7 +3981,7 @@ Supported arguments for GIO_USE_FILE_MONITOR environment
variable:
(intern-soft
(tramp-compat-string-replace "_" "-" (downcase x))))
(split-string (match-string 1 line) "," 'omit))
- (or (match-string 3 line)
+ (or (match-string 2 line)
(file-name-nondirectory (process-get proc 'watch-name))))))
;; Usually, we would add an Emacs event now. Unfortunately,
;; `unread-command-events' does not accept several events at
@@ -3906,10 +4005,10 @@ Supported arguments for GIO_USE_FILE_MONITOR
environment variable:
(goto-char (point-min))
(forward-line)
(when (looking-at
- (concat "\\(?:^/[^[:space:]]*[[:space:]]\\)?"
- "[[:space:]]*\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)"))
+ (rx (? bol "/" (* (not blank)) blank) (* blank)
+ (group (+ digit)) (+ blank)
+ (group (+ digit)) (+ blank)
+ (group (+ digit))))
(mapcar
(lambda (d)
(* d (tramp-get-connection-property v "df-blocksize" 0)))
@@ -3924,40 +4023,73 @@ Supported arguments for GIO_USE_FILE_MONITOR
environment variable:
(defun tramp-expand-script (vec script)
"Expand SCRIPT with remote files or commands.
-\"%a\", \"%h\", \"%o\" and \"%p\" format specifiers are replaced
-by the respective `awk', `hexdump', `od' and `perl' commands.
-\"%n\" is replaced by \"2>/dev/null\", and \"%t\" is replaced by
-a temporary file name.
-If VEC is nil, the respective local commands are used.
-If there is a format specifier which cannot be expanded, this
-function returns nil."
- (if (not (string-match-p "\\(^\\|[^%]\\)%[ahnopt]" script))
+\"%a\", \"%h\", \"%l\", \"%o\", \"%p\", \"%r\", \"%s\" and \"%y\"
+format specifiers are replaced by the respective `awk',
+`hexdump', `ls', `od', `perl', `readlink', `stat' and `python'
+commands. \"%n\" is replaced by \"2>/dev/null\", and \"%t\" is
+replaced by a temporary file name. If VEC is nil, the respective
+local commands are used. If there is a format specifier which
+cannot be expanded, this function returns nil."
+ (if (not (string-match-p
+ (tramp-compat-rx (| bol (not "%")) "%" (any "ahlnoprsty")) script))
script
(catch 'wont-work
- (let ((awk (when (string-match-p "\\(^\\|[^%]\\)%a" script)
+ (let ((awk (when (string-match-p
+ (tramp-compat-rx (| bol (not "%")) "%a") script)
(or
(if vec (tramp-get-remote-awk vec) (executable-find "awk"))
(throw 'wont-work nil))))
- (hdmp (when (string-match-p "\\(^\\|[^%]\\)%h" script)
+ (hdmp (when (string-match-p
+ (tramp-compat-rx (| bol (not "%")) "%h") script)
(or
(if vec (tramp-get-remote-hexdump vec)
(executable-find "hexdump"))
(throw 'wont-work nil))))
- (dev (when (string-match-p "\\(^\\|[^%]\\)%n" script)
+ (dev (when (string-match-p
+ (tramp-compat-rx (| bol (not "%")) "%n") script)
(or
(if vec (concat "2>" (tramp-get-remote-null-device vec))
(if (eq system-type 'windows-nt) ""
(concat "2>" null-device)))
(throw 'wont-work nil))))
- (od (when (string-match-p "\\(^\\|[^%]\\)%o" script)
+ (ls (when (string-match-p
+ (tramp-compat-rx (| bol (not "%")) "%l") script)
+ (format "%s %s"
+ (or (tramp-get-ls-command vec)
+ (throw 'wont-work nil))
+ (tramp-sh--quoting-style-options vec))))
+ (od (when (string-match-p
+ (tramp-compat-rx (| bol (not "%")) "%o") script)
(or (if vec (tramp-get-remote-od vec) (executable-find "od"))
(throw 'wont-work nil))))
- (perl (when (string-match-p "\\(^\\|[^%]\\)%p" script)
+ (perl (when (string-match-p
+ (tramp-compat-rx (| bol (not "%")) "%p") script)
(or
(if vec
(tramp-get-remote-perl vec) (executable-find "perl"))
(throw 'wont-work nil))))
- (tmp (when (string-match-p "\\(^\\|[^%]\\)%t" script)
+ (python (when (string-match-p
+ (tramp-compat-rx (| bol (not "%")) "%y") script)
+ (or
+ (if vec
+ (tramp-get-remote-python vec)
+ (executable-find "python"))
+ (throw 'wont-work nil))))
+ (readlink (when (string-match-p
+ (tramp-compat-rx (| bol (not "%")) "%r") script)
+ (or
+ (if vec
+ (tramp-get-remote-readlink vec)
+ (executable-find "readlink"))
+ (throw 'wont-work nil))))
+ (stat (when (string-match-p
+ (tramp-compat-rx (| bol (not "%")) "%s") script)
+ (or
+ (if vec
+ (tramp-get-remote-stat vec) (executable-find "stat"))
+ (throw 'wont-work nil))))
+ (tmp (when (string-match-p
+ (tramp-compat-rx (| bol (not "%")) "%t") script)
(or
(if vec
(tramp-file-local-name (tramp-make-tramp-temp-name vec))
@@ -3965,7 +4097,9 @@ function returns nil."
(throw 'wont-work nil)))))
(format-spec
script
- (format-spec-make ?a awk ?h hdmp ?n dev ?o od ?p perl ?t tmp))))))
+ (format-spec-make
+ ?a awk ?h hdmp ?l ls ?n dev ?o od ?p perl
+ ?r readlink ?s stat ?t tmp ?y python))))))
(defun tramp-maybe-send-script (vec script name)
"Define in remote shell function NAME implemented as SCRIPT.
@@ -3973,7 +4107,7 @@ Only send the definition if it has not already been done."
;; We cannot let-bind (tramp-get-connection-process vec) because it
;; might be nil.
(let ((scripts (tramp-get-connection-property
- (tramp-get-connection-process vec) "scripts" nil)))
+ (tramp-get-connection-process vec) "scripts")))
(unless (member name scripts)
(with-tramp-progress-reporter
vec 5 (format-message "Sending script `%s'" name)
@@ -4028,7 +4162,7 @@ This function expects to be in the right *tramp* buffer."
(unless (or ignore-path (tramp-check-remote-uname vec
tramp-sunos-unames))
(tramp-send-command vec (format "which \\%s | wc -w" progname))
(goto-char (point-min))
- (if (looking-at-p "^\\s-*1$")
+ (if (looking-at-p (rx bol (* blank) "1" eol))
(setq result (concat "\\" progname))))
(unless result
(when ignore-tilde
@@ -4055,7 +4189,7 @@ This function expects to be in the right *tramp* buffer."
(when (search-backward "tramp_executable " nil t)
(skip-chars-forward "^ ")
(skip-chars-forward " ")
- (setq result (buffer-substring (point) (point-at-eol)))))
+ (setq result (buffer-substring (point) (line-end-position)))))
result)))
;; On hydra.nixos.org, the $PATH environment variable is too long to
@@ -4068,7 +4202,8 @@ whether it exists and if so, it is added to the
environment
variable PATH."
(let ((command
(format
- "PATH=%s && export PATH" (string-join (tramp-get-remote-path vec)
":")))
+ "PATH=%s && export PATH"
+ (string-join (tramp-get-remote-path vec) ":")))
(pipe-buf
(with-tramp-connection-property vec "pipe-buf"
(tramp-send-command-and-read
@@ -4181,14 +4316,17 @@ file exists and nonzero exit status otherwise."
;; by some sh implementations (eg, bash when called as sh) on
;; startup; this way, we avoid the startup file clobbering $PS1.
;; $PROMPT_COMMAND is another way to set the prompt in /bin/bash,
- ;; it must be discarded as well. $HISTFILE is set according to
- ;; `tramp-histfile-override'. $TERM and $INSIDE_EMACS set here to
- ;; ensure they have the correct values when the shell starts, not
- ;; just processes run within the shell. (Which processes include
- ;; our initial probes to ensure the remote shell is usable.)
- ;; For the time being, we assume that all shells interpret -i as
- ;; interactive shell. Must be the last argument, because (for
- ;; example) bash expects long options first.
+ ;; it must be discarded as well. Some ssh daemons (for example,
+ ;; on Android devices) do not acknowledge the $PS1 setting in
+ ;; that call, so we make a further sanity check. (Bug#57044)
+ ;; $HISTFILE is set according to `tramp-histfile-override'. $TERM
+ ;; and $INSIDE_EMACS set here to ensure they have the correct
+ ;; values when the shell starts, not just processes run within the
+ ;; shell. (Which processes include our initial probes to ensure
+ ;; the remote shell is usable.) For the time being, we assume
+ ;; that all shells interpret -i as interactive shell. Must be the
+ ;; last argument, because (for example) bash expects long options
+ ;; first.
(tramp-send-command
vec (format
(concat
@@ -4204,7 +4342,27 @@ file exists and nonzero exit status otherwise."
""))
(tramp-shell-quote-argument tramp-end-of-output)
shell (or (tramp-get-sh-extra-args shell) ""))
- t)
+ t t)
+
+ ;; Sanity check.
+ (tramp-barf-if-no-shell-prompt
+ (tramp-get-connection-process vec) 60
+ "Couldn't find remote shell prompt for %s" shell)
+ (unless
+ (tramp-check-for-regexp
+ (tramp-get-connection-process vec)
+ (tramp-compat-rx (literal tramp-end-of-output)))
+ (tramp-wait-for-output (tramp-get-connection-process vec))
+ (tramp-message vec 5 "Setting shell prompt")
+ (tramp-send-command
+ vec (format "PS1=%s PS2='' PS3='' PROMPT_COMMAND=''"
+ (tramp-shell-quote-argument tramp-end-of-output))
+ t t)
+ (tramp-barf-if-no-shell-prompt
+ (tramp-get-connection-process vec) 60
+ "Couldn't find remote shell prompt for %s" shell))
+ (tramp-wait-for-output (tramp-get-connection-process vec))
+
;; Check proper HISTFILE setting. We give up when not working.
(when (and (stringp tramp-histfile-override)
(file-name-directory tramp-histfile-override))
@@ -4223,7 +4381,7 @@ file exists and nonzero exit status otherwise."
(defun tramp-find-shell (vec)
"Open a shell on the remote host which groks tilde expansion."
;; If we are in `make-process', we don't need another shell.
- (unless (tramp-get-connection-property vec "process-name" nil)
+ (unless (tramp-get-connection-property vec "process-name")
(with-current-buffer (tramp-get-buffer vec)
(let ((default-shell (tramp-get-method-parameter vec
'tramp-remote-shell))
shell)
@@ -4231,8 +4389,12 @@ file exists and nonzero exit status otherwise."
(with-tramp-connection-property vec "remote-shell"
;; CCC: "root" does not exist always, see my QNAP
;; TS-459. Which check could we apply instead?
- (tramp-send-command vec "echo ~root" t)
- (if (or (string-match-p "^~root$" (buffer-string))
+ (tramp-send-command
+ vec (format "echo ~%s" tramp-root-id-string) t)
+ (if (or (string-match-p
+ (tramp-compat-rx
+ bol "~" (literal tramp-root-id-string) eol)
+ (buffer-string))
;; The default shell (ksh93) of OpenSolaris
;; and Solaris is buggy. We've got reports
;; for "SunOS 5.10" and "SunOS 5.11" so far.
@@ -4270,8 +4432,9 @@ seconds. If not, it produces an error message with the
given ERROR-ARGS."
(condition-case nil
(tramp-wait-for-regexp
proc timeout
- (format
- "\\(%s\\|%s\\)\\'" shell-prompt-pattern tramp-shell-prompt-pattern))
+ (tramp-compat-rx
+ (| (regexp shell-prompt-pattern) (regexp tramp-shell-prompt-pattern))
+ eos))
(error
(delete-process proc)
(apply #'tramp-error-with-buffer
@@ -4281,8 +4444,7 @@ seconds. If not, it produces an error message with the
given ERROR-ARGS."
"Set up an interactive shell.
Mainly sets the prompt and the echo correctly. PROC is the shell
process to set up. VEC specifies the connection."
- (let ((tramp-end-of-output tramp-initial-end-of-output)
- (case-fold-search t))
+ (let ((case-fold-search t))
(tramp-open-shell vec (tramp-get-method-parameter vec 'tramp-remote-shell))
(tramp-message vec 5 "Setting up remote shell environment")
@@ -4309,27 +4471,36 @@ process to set up. VEC specifies the connection."
;; width magic interferes with them.
(tramp-send-command vec "stty icanon erase ^H cols 32767" t))))
- (tramp-message vec 5 "Setting shell prompt")
- (tramp-send-command
- vec (format "PS1=%s PS2='' PS3='' PROMPT_COMMAND=''"
- (tramp-shell-quote-argument tramp-end-of-output))
- t)
-
;; Check whether the output of "uname -sr" has been changed. If
;; yes, this is a strong indication that we must expire all
;; connection properties. We start again with
- ;; `tramp-maybe-open-connection', it will be caught there.
+ ;; `tramp-maybe-open-connection', it will be caught there. The same
+ ;; check will be applied with the function kept in `tramp-config-check'.
(tramp-message vec 5 "Checking system information")
- (let* ((old-uname (tramp-get-connection-property vec "uname" nil))
+ (let* ((old-uname (tramp-get-connection-property vec "uname"))
(uname
;; If we are in `make-process', we don't need to recompute.
- (if (and old-uname
- (tramp-get-connection-property vec "process-name" nil))
+ (if (and old-uname (tramp-get-connection-property vec "process-name"))
old-uname
(tramp-set-connection-property
vec "uname"
- (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\"")))))
- (when (and (stringp old-uname) (not (string-equal old-uname uname)))
+ (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\""))))
+ (config-check-function
+ (tramp-get-method-parameter vec 'tramp-config-check))
+ (old-config-check
+ (and config-check-function
+ (tramp-get-connection-property vec "config-check-data")))
+ (config-check
+ (and config-check-function
+ ;; If we are in `make-process', we don't need to recompute.
+ (if (and old-config-check
+ (tramp-get-connection-property vec "process-name"))
+ old-config-check
+ (tramp-set-connection-property
+ vec "config-check-data"
+ (tramp-compat-funcall config-check-function vec))))))
+ (when (and (stringp old-uname) (stringp uname)
+ (not (string-equal old-uname uname)))
(tramp-message
vec 3
"Connection reset, because remote host changed from `%s' to `%s'"
@@ -4337,6 +4508,15 @@ process to set up. VEC specifies the connection."
;; We want to keep the password.
(tramp-cleanup-connection vec t t)
(throw 'uname-changed (tramp-maybe-open-connection vec)))
+ (when (and (stringp old-config-check) (stringp config-check)
+ (not (string-equal old-config-check config-check)))
+ (tramp-message
+ vec 3
+ "Connection reset, because remote configuration changed from `%s' to
`%s'"
+ old-config-check config-check)
+ ;; We want to keep the password.
+ (tramp-cleanup-connection vec t t)
+ (throw 'uname-changed (tramp-maybe-open-connection vec)))
;; Try to set up the coding system correctly.
;; CCC this can't be the right way to do it. Hm.
@@ -4348,7 +4528,8 @@ process to set up. VEC specifies the connection."
(string-prefix-p "Darwin" uname)
(cons 'utf-8-hfs 'utf-8-hfs))
(and (memq 'utf-8 (coding-system-list))
- (string-match-p "utf-?8" (tramp-get-remote-locale vec))
+ (string-match-p
+ (rx "utf" (? "-") "8") (tramp-get-remote-locale vec))
(cons 'utf-8 'utf-8))
(process-coding-system proc)
(cons 'undecided 'undecided)))
@@ -4380,7 +4561,7 @@ process to set up. VEC specifies the connection."
(t
(tramp-message
vec 5 "Checking remote host type for `send-process-string' bug")
- (if (string-match-p "FreeBSD\\|DragonFly" uname) 500 0))))
+ (if (string-match-p (rx (| "FreeBSD" "DragonFly")) uname) 500 0))))
;; Set remote PATH variable.
(tramp-set-remote-path vec)
@@ -4412,7 +4593,7 @@ process to set up. VEC specifies the connection."
(tramp-send-command vec "set +H" t))
;; Disable tab expansion.
- (if (string-match-p "BSD\\|DragonFly\\|Darwin" uname)
+ (if (string-match-p (rx (| "BSD" "DragonFly" "Darwin")) uname)
(tramp-send-command vec "stty tabs" t)
(tramp-send-command vec "stty tab0" t))
@@ -4440,7 +4621,7 @@ process to set up. VEC specifies the connection."
(copy-sequence tramp-remote-process-environment))))
(setq item (split-string item "=" 'omit))
(setcdr item (string-join (cdr item) "="))
- (if (and (stringp (cdr item)) (not (string-equal (cdr item) "")))
+ (if (and (stringp (cdr item)) (not (string-empty-p (cdr item))))
(push (format "%s %s" (car item) (cdr item)) vars)
(push (car item) unset)))
(when vars
@@ -4638,7 +4819,7 @@ Goes through the list `tramp-local-coding-commands' and
(with-current-buffer (tramp-get-connection-buffer vec)
(goto-char (point-min))
- (unless (looking-at-p (regexp-quote magic))
+ (unless (looking-at-p (tramp-compat-rx (literal magic)))
(throw 'wont-work-remote nil)))
;; `rem-enc' and `rem-dec' could be a string meanwhile.
@@ -4724,7 +4905,7 @@ Goes through the list `tramp-inline-compress-commands'."
nil t))
(throw 'next nil))
(goto-char (point-min))
- (unless (looking-at-p (regexp-quote magic))
+ (unless (looking-at-p (tramp-compat-rx (literal magic)))
(throw 'next nil)))
(tramp-message
vec 5
@@ -4735,7 +4916,7 @@ Goes through the list `tramp-inline-compress-commands'."
(throw 'next nil))
(with-current-buffer (tramp-get-buffer vec)
(goto-char (point-min))
- (unless (looking-at-p (regexp-quote magic))
+ (unless (looking-at-p (tramp-compat-rx (literal magic)))
(throw 'next nil)))
(setq found t)))
@@ -4812,7 +4993,7 @@ Goes through the list `tramp-inline-compress-commands'."
((stringp tramp-scp-strict-file-name-checking)
tramp-scp-strict-file-name-checking)
- ;; Determine the options.
+ ;; Determine the option.
(t (setq tramp-scp-strict-file-name-checking "")
(let ((case-fold-search t))
(ignore-errors
@@ -4824,7 +5005,7 @@ Goes through the list `tramp-inline-compress-commands'."
(goto-char (point-min))
(unless
(search-forward-regexp
- "\\(illegal\\|unknown\\) option -- T" nil t)
+ (rx (| "illegal" "unknown") " option -- T") nil t)
(setq tramp-scp-strict-file-name-checking "-T")))))))
tramp-scp-strict-file-name-checking)))
@@ -4851,15 +5032,92 @@ Goes through the list `tramp-inline-compress-commands'."
(goto-char (point-min))
(unless
(search-forward-regexp
- "\\(illegal\\|unknown\\) option -- O" nil t)
+ (rx (| "illegal" "unknown") " option -- O") nil t)
(setq tramp-scp-force-scp-protocol "-O")))))))
tramp-scp-force-scp-protocol)))
+(defun tramp-scp-direct-remote-copying (vec1 vec2)
+ "Return the direct remote copying argument of the local scp."
+ (cond
+ ((or (not tramp-use-scp-direct-remote-copying) (null vec1) (null vec2)
+ (not (tramp-get-process vec1))
+ (not (equal (tramp-file-name-port vec1) (tramp-file-name-port vec2)))
+ (null (assoc "%z" (tramp-get-method-parameter vec1 'tramp-copy-args)))
+ (null (assoc "%z" (tramp-get-method-parameter vec2 'tramp-copy-args))))
+ "")
+
+ ((let ((case-fold-search t))
+ (and
+ ;; Check, whether "scp" supports "-R" option.
+ (with-tramp-connection-property nil "scp-R"
+ (when (executable-find "scp")
+ (with-temp-buffer
+ (tramp-call-process vec1 "scp" nil t nil "-R")
+ (goto-char (point-min))
+ (not (search-forward-regexp
+ (rx (| "illegal" "unknown") " option -- R") nil 'noerror)))))
+
+ ;; Check, that RemoteCommand is not used.
+ (with-tramp-connection-property
+ (tramp-get-process vec1) "ssh-remote-command"
+ (let ((command `("ssh" "-G" ,(tramp-file-name-host vec1))))
+ (with-temp-buffer
+ (tramp-call-process
+ vec1 tramp-encoding-shell nil t nil
+ tramp-encoding-command-switch
+ (mapconcat #'identity command " "))
+ (goto-char (point-min))
+ (not (search-forward "remotecommand" nil 'noerror)))))
+
+ ;; Check hostkeys.
+ (with-tramp-connection-property
+ (tramp-get-process vec1)
+ (concat "direct-remote-copying-"
+ (tramp-make-tramp-file-name vec2 'noloc))
+ (let ((command
+ (append
+ `("ssh" "-G" ,(tramp-file-name-host vec2) "|"
+ "grep" "-i" "^hostname" "|" "cut" "-d\" \"" "-f2" "|"
+ "ssh-keyscan" "-f" "-")
+ (when (tramp-file-name-port vec2)
+ `("-p" ,(tramp-file-name-port vec2)))))
+ found string)
+ (with-temp-buffer
+ ;; Check hostkey of VEC2, seen from VEC1.
+ (tramp-send-command vec1 (mapconcat #'identity command " "))
+ ;; Check hostkey of VEC2, seen locally.
+ (tramp-call-process
+ vec1 tramp-encoding-shell nil t nil tramp-encoding-command-switch
+ (mapconcat #'identity command " "))
+ (goto-char (point-min))
+ (while (and (not found) (not (eobp)))
+ (setq string
+ (buffer-substring
+ (line-beginning-position) (line-end-position))
+ string
+ (and
+ (string-match
+ (rx bol (+ (not (any blank "#"))) blank
+ (+ (not blank)) blank
+ (group (+ (not blank))) eol)
+ string)
+ (match-string 1 string))
+ found
+ (and string
+ (with-current-buffer (tramp-get-buffer vec1)
+ (goto-char (point-min))
+ (search-forward string nil 'noerror))))
+ (forward-line))
+ found)))))
+ "-R")
+
+ (t "-3")))
+
(defun tramp-timeout-session (vec)
"Close the connection VEC after a session timeout.
If there is just some editing, retry it after 5 seconds."
(if (and (tramp-get-connection-property
- (tramp-get-connection-process vec) "locked" nil)
+ (tramp-get-connection-process vec) "locked")
(tramp-file-name-equal-p vec (car tramp-current-connection)))
(progn
(tramp-message
@@ -4878,7 +5136,7 @@ connection if a previous connection has died for some
reason."
(throw 'non-essential 'non-essential))
(let ((p (tramp-get-connection-process vec))
- (process-name (tramp-get-connection-property vec "process-name" nil))
+ (process-name (tramp-get-connection-property vec "process-name"))
(process-environment (copy-sequence process-environment))
(pos (with-current-buffer (tramp-get-connection-buffer vec) (point))))
@@ -4949,8 +5207,7 @@ connection if a previous connection has died for some
reason."
(tramp-error vec 'file-error "`tramp-encoding-shell' not set"))
(let* ((current-host tramp-system-name)
(target-alist (tramp-compute-multi-hops vec))
- ;; Needed for `tramp-get-remote-null-device'.
- (previous-hop nil)
+ (previous-hop tramp-null-hop)
;; We will apply `tramp-ssh-controlmaster-options'
;; only for the first hop.
(options (tramp-ssh-controlmaster-options vec))
@@ -5035,9 +5292,14 @@ connection if a previous connection has died for some
reason."
;; Set password prompt vector.
(tramp-set-connection-property
p "password-vector"
- (make-tramp-file-name
- :method l-method :user l-user :domain l-domain
- :host l-host :port l-port))
+ (if (tramp-get-method-parameter
+ hop 'tramp-password-previous-hop)
+ (let ((pv (copy-tramp-file-name previous-hop)))
+ (setf (tramp-file-name-method pv) l-method)
+ pv)
+ (make-tramp-file-name
+ :method l-method :user l-user :domain l-domain
+ :host l-host :port l-port)))
;; Set session timeout.
(when (tramp-get-method-parameter
@@ -5088,9 +5350,9 @@ connection if a previous connection has died for some
reason."
previous-hop hop)))
;; Activate session timeout.
- (when (tramp-get-connection-property p "session-timeout" nil)
+ (when (tramp-get-connection-property p "session-timeout")
(run-at-time
- (tramp-get-connection-property p "session-timeout" nil) nil
+ (tramp-get-connection-property p "session-timeout") nil
#'tramp-timeout-session vec))
;; Make initial shell settings.
@@ -5112,7 +5374,7 @@ is meant to be used from `tramp-maybe-open-connection'
only. The
function waits for output unless NOOUTPUT is set."
(unless neveropen (tramp-maybe-open-connection vec))
(let ((p (tramp-get-connection-process vec)))
- (when (tramp-get-connection-property p "remote-echo" nil)
+ (when (tramp-get-connection-property p "remote-echo")
;; We mark the command string that it can be erased in the output buffer.
(tramp-set-connection-property p "check-remote-echo" t)
;; If we put `tramp-echo-mark' after a trailing newline (which
@@ -5143,20 +5405,23 @@ function waits for output unless NOOUTPUT is set."
;; Busyboxes built with the EDITING_ASK_TERMINAL config
;; option send also escape sequences, which must be
;; ignored.
- (regexp (format "[^#$\n]*%s\\(%s\\)?\r?$"
- (regexp-quote tramp-end-of-output)
- tramp-device-escape-sequence-regexp))
+ (regexp (tramp-compat-rx
+ (* (not (any "#$\n")))
+ (literal tramp-end-of-output)
+ (? (regexp tramp-device-escape-sequence-regexp))
+ (? "\r") eol))
;; Sometimes, the commands do not return a newline but a
;; null byte before the shell prompt, for example "git
;; ls-files -c -z ...".
- (regexp1 (format "\\(^\\|\000\\)%s" regexp))
+ (regexp1 (tramp-compat-rx (| bol "\000") (regexp regexp)))
(found (tramp-wait-for-regexp proc timeout regexp1)))
(if found
(let ((inhibit-read-only t))
;; A simple-minded busybox has sent " ^H" sequences.
;; Delete them.
(goto-char (point-min))
- (when (re-search-forward "^\\(.\b\\)+$" (point-at-eol) t)
+ (when (re-search-forward
+ (rx bol (+ nonl "\b") eol) (line-end-position) t)
(forward-line 1)
(delete-region (point-min) (point)))
;; Delete the prompt.
@@ -5185,18 +5450,28 @@ executed in a subshell, ie surrounded by parentheses.
If
DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to \"/dev/null\".
Optional argument EXIT-STATUS, if non-nil, triggers the return of
the exit status."
- (tramp-send-command
- vec
- (concat (if subshell "( " "")
- command
- (if command
- (if dont-suppress-err
- "; " (format " 2>%s; " (tramp-get-remote-null-device vec)))
- "")
- "echo tramp_exit_status $?"
- (if subshell " )" "")))
+ (let (cmd data)
+ (if (and (stringp command)
+ (string-match
+ (tramp-compat-rx
+ (* nonl) "<<'" (literal tramp-end-of-heredoc) "'" (* nonl))
+ command))
+ (setq cmd (match-string 0 command)
+ data (substring command (match-end 0)))
+ (setq cmd command))
+ (tramp-send-command
+ vec
+ (concat (if subshell "( " "")
+ cmd
+ (if cmd
+ (if dont-suppress-err
+ "; " (format " 2>%s; " (tramp-get-remote-null-device
vec)))
+ "")
+ "echo tramp_exit_status $?"
+ (if subshell " )" "")
+ data)))
(with-current-buffer (tramp-get-connection-buffer vec)
- (unless (tramp-search-regexp "tramp_exit_status [[:digit:]]+")
+ (unless (tramp-search-regexp (rx "tramp_exit_status " (+ digit)))
(tramp-error
vec 'file-error "Couldn't find exit status of `%s'" command))
(skip-chars-forward "^ ")
@@ -5241,7 +5516,7 @@ raises an error."
(unless noerror signal-hook-function)))
(read (current-buffer)))
;; Error handling.
- (when (re-search-forward "\\S-" (point-at-eol) t)
+ (when (re-search-forward (rx (not blank)) (line-end-position) t)
(error nil)))
(error (unless noerror
(tramp-error
@@ -5249,94 +5524,6 @@ raises an error."
"`%s' does not return a valid Lisp expression: `%s'"
command (buffer-string))))))))
-;; FIXME: Move to tramp.el?
-;;;###tramp-autoload
-(defun tramp-convert-file-attributes (vec attr)
- "Convert `file-attributes' ATTR generated by perl script, stat or ls.
-Convert file mode bits to string and set virtual device number.
-Return ATTR."
- (when attr
- (save-match-data
- ;; Remove color escape sequences from symlink.
- (when (stringp (car attr))
- (while (string-match tramp-display-escape-sequence-regexp (car attr))
- (setcar attr (replace-match "" nil nil (car attr)))))
- ;; Convert uid and gid. Use `tramp-unknown-id-integer' as
- ;; indication of unusable value.
- (when (and (numberp (nth 2 attr)) (< (nth 2 attr) 0))
- (setcar (nthcdr 2 attr) tramp-unknown-id-integer))
- (when (and (floatp (nth 2 attr))
- (<= (nth 2 attr) most-positive-fixnum))
- (setcar (nthcdr 2 attr) (round (nth 2 attr))))
- (when (and (numberp (nth 3 attr)) (< (nth 3 attr) 0))
- (setcar (nthcdr 3 attr) tramp-unknown-id-integer))
- (when (and (floatp (nth 3 attr))
- (<= (nth 3 attr) most-positive-fixnum))
- (setcar (nthcdr 3 attr) (round (nth 3 attr))))
- ;; Convert last access time.
- (unless (listp (nth 4 attr))
- (setcar (nthcdr 4 attr) (seconds-to-time (nth 4 attr))))
- ;; Convert last modification time.
- (unless (listp (nth 5 attr))
- (setcar (nthcdr 5 attr) (seconds-to-time (nth 5 attr))))
- ;; Convert last status change time.
- (unless (listp (nth 6 attr))
- (setcar (nthcdr 6 attr) (seconds-to-time (nth 6 attr))))
- ;; Convert file size.
- (when (< (nth 7 attr) 0)
- (setcar (nthcdr 7 attr) -1))
- (when (and (floatp (nth 7 attr))
- (<= (nth 7 attr) most-positive-fixnum))
- (setcar (nthcdr 7 attr) (round (nth 7 attr))))
- ;; Convert file mode bits to string.
- (unless (stringp (nth 8 attr))
- (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr)))
- (when (stringp (car attr))
- (aset (nth 8 attr) 0 ?l)))
- ;; Convert directory indication bit.
- (when (string-prefix-p "d" (nth 8 attr))
- (setcar attr t))
- ;; Convert symlink from `tramp-do-file-attributes-with-stat'.
- ;; Decode also multibyte string.
- (when (consp (car attr))
- (setcar attr
- (and (stringp (caar attr))
- (string-match ".+ -> .\\(.+\\)." (caar attr))
- (decode-coding-string
- (match-string 1 (caar attr)) 'utf-8))))
- ;; Set file's gid change bit.
- (setcar (nthcdr 9 attr)
- (if (numberp (nth 3 attr))
- (not (= (nth 3 attr)
- (tramp-get-remote-gid vec 'integer)))
- (not (string-equal
- (nth 3 attr)
- (tramp-get-remote-gid vec 'string)))))
- ;; Convert inode.
- (when (floatp (nth 10 attr))
- (setcar (nthcdr 10 attr)
- (condition-case nil
- (let ((high (nth 10 attr))
- middle low)
- (if (<= high most-positive-fixnum)
- (floor high)
- ;; The low 16 bits.
- (setq low (mod high #x10000)
- high (/ high #x10000))
- (if (<= high most-positive-fixnum)
- (cons (floor high) (floor low))
- ;; The middle 24 bits.
- (setq middle (mod high #x1000000)
- high (/ high #x1000000))
- (cons (floor high)
- (cons (floor middle) (floor low))))))
- ;; Inodes can be incredible huge. We must hide this.
- (error (tramp-get-inode vec)))))
- ;; Set virtual device number.
- (setcar (nthcdr 11 attr)
- (tramp-get-device vec)))
- attr))
-
(defun tramp-shell-case-fold (string)
"Convert STRING to shell glob pattern which ignores case."
(mapconcat
@@ -5359,7 +5546,7 @@ Return ATTR."
;; This does not work for MS Windows scp, if there are characters
;; to be quoted. OpenSSH 8 supports disabling of strict file name
;; checking in scp, we use it when available.
- (unless (string-match-p "ftp$" method)
+ (unless (string-match-p (rx "ftp" eos) method)
(setq localname (tramp-unquote-shell-quote-argument localname)))
(cond
((tramp-get-method-parameter vec 'tramp-remote-copy-program)
@@ -5437,7 +5624,7 @@ Nonexistent directories are removed from spec."
(tramp-get-method-parameter vec 'tramp-remote-shell-args)
" ")
(tramp-shell-quote-argument tramp-end-of-heredoc))
- 'noerror (regexp-quote tramp-end-of-heredoc))
+ 'noerror (tramp-compat-rx (literal tramp-end-of-heredoc)))
(progn
(tramp-message
vec 2 "Could not retrieve `tramp-own-remote-path'")
@@ -5473,7 +5660,7 @@ Nonexistent directories are removed from spec."
(lambda (x)
(and
(stringp x)
- (file-directory-p (tramp-make-tramp-file-name vec x 'nohop))
+ (file-directory-p (tramp-make-tramp-file-name vec x))
x))
remote-path))))))
@@ -5486,8 +5673,9 @@ Nonexistent directories are removed from spec."
(with-current-buffer (tramp-get-connection-buffer vec)
(while candidates
(goto-char (point-min))
- (if (string-match-p (format "^%s\r?$" (regexp-quote (car candidates)))
- (buffer-string))
+ (if (string-match-p
+ (tramp-compat-rx bol (literal (car candidates)) (? "\r") eol)
+ (buffer-string))
(setq locale (car candidates)
candidates nil)
(setq candidates (cdr candidates)))))
@@ -5512,10 +5700,14 @@ Nonexistent directories are removed from spec."
;; "--color=never" argument (for example on FreeBSD).
(when (tramp-send-command-and-check
vec (format "%s -lnd /" result))
- (when (tramp-send-command-and-check
- vec (format
- "%s --color=never -al %s"
- result (tramp-get-remote-null-device vec)))
+ (when (and (tramp-send-command-and-check
+ vec (format
+ "%s --color=never -al %s"
+ result (tramp-get-remote-null-device vec)))
+ (not (string-match-p
+ "\e"
+ (tramp-get-buffer-string
+ (tramp-get-buffer vec)))))
(setq result (concat result " --color=never")))
(throw 'ls-found result))
(setq dl (cdr dl))))))
@@ -5561,7 +5753,7 @@ Nonexistent directories are removed from spec."
vec (format "( %s / -nt / )" (tramp-get-test-command vec)))
(with-current-buffer (tramp-get-buffer vec)
(goto-char (point-min))
- (when (looking-at-p (regexp-quote tramp-end-of-output))
+ (when (looking-at-p (tramp-compat-rx (literal tramp-end-of-output)))
(format "%s %%s -nt %%s" (tramp-get-test-command vec)))))
(progn
(tramp-send-command
@@ -5626,7 +5818,9 @@ Nonexistent directories are removed from spec."
tmp (tramp-send-command-and-read
vec (format "%s -c '(\"%%N\" %%s)' /" result) 'noerror))
(unless (and (listp tmp) (stringp (car tmp))
- (string-match-p "^[\"`‘„”«「]/[\"'’“”»」]$" (car tmp))
+ (string-match-p
+ (rx bol (any "\"`'‘„”«「") "/" (any "\"'’“”»」") eol)
+ (car tmp))
(integerp (cadr tmp)))
(setq result nil)))
result))))
@@ -5721,74 +5915,13 @@ This command is returned only if
`delete-by-moving-to-trash' is non-nil."
(throw 'id-found result))
(setq dl (cdr dl))))))))
-(defun tramp-get-remote-uid-with-id (vec id-format)
- "Implement `tramp-get-remote-uid' for Tramp files using `id'."
- (tramp-send-command-and-read
- vec
- (format "%s -u%s %s"
- (tramp-get-remote-id vec)
- (if (equal id-format 'integer) "" "n")
- (if (equal id-format 'integer)
- "" "| sed -e s/^/\\\"/ -e s/\\$/\\\"/"))))
-
-(defun tramp-get-remote-uid-with-perl (vec id-format)
- "Implement `tramp-get-remote-uid' for Tramp files using a Perl script."
- (tramp-send-command-and-read
- vec
- (format "%s -le '%s'"
- (tramp-get-remote-perl vec)
- (if (equal id-format 'integer)
- "print $>"
- "print \"\\\"\", scalar getpwuid($>), \"\\\"\""))))
-
(defun tramp-get-remote-python (vec)
"Determine remote `python' command."
(with-tramp-connection-property vec "python"
(tramp-message vec 5 "Finding a suitable `python' command")
(or (tramp-find-executable vec "python" (tramp-get-remote-path vec))
- (tramp-find-executable vec "python2" (tramp-get-remote-path vec))
(tramp-find-executable vec "python3" (tramp-get-remote-path vec)))))
-(defun tramp-get-remote-uid-with-python (vec id-format)
- "Implement `tramp-get-remote-uid' for Tramp files using `python'."
- (tramp-send-command-and-read
- vec
- (format "%s -c \"%s\""
- (tramp-get-remote-python vec)
- (if (equal id-format 'integer)
- "import os; print (os.getuid())"
- "import os, pwd; print ('\\\"' + pwd.getpwuid(os.getuid())[0] +
'\\\"')"))))
-
-(defun tramp-get-remote-gid-with-id (vec id-format)
- "Implement `tramp-get-remote-gid' for Tramp files using `id'."
- (tramp-send-command-and-read
- vec
- (format "%s -g%s %s"
- (tramp-get-remote-id vec)
- (if (equal id-format 'integer) "" "n")
- (if (equal id-format 'integer)
- "" "| sed -e s/^/\\\"/ -e s/\\$/\\\"/"))))
-
-(defun tramp-get-remote-gid-with-perl (vec id-format)
- "Implement `tramp-get-remote-gid' for Tramp files using a Perl script."
- (tramp-send-command-and-read
- vec
- (format "%s -le '%s'"
- (tramp-get-remote-perl vec)
- (if (equal id-format 'integer)
- "print ($)=~/(\\d+)/)"
- "print \"\\\"\", scalar getgrgid($)), \"\\\"\""))))
-
-(defun tramp-get-remote-gid-with-python (vec id-format)
- "Implement `tramp-get-remote-gid' for Tramp files using `python'."
- (tramp-send-command-and-read
- vec
- (format "%s -c \"%s\""
- (tramp-get-remote-python vec)
- (if (equal id-format 'integer)
- "import os; print (os.getgid())"
- "import os, grp; print ('\\\"' + grp.getgrgid(os.getgid())[0] +
'\\\"')"))))
-
(defun tramp-get-remote-busybox (vec)
"Determine remote `busybox' command."
(with-tramp-connection-property vec "busybox"
@@ -5879,7 +6012,7 @@ If no corresponding command is found, nil is returned."
(> size tramp-inline-compress-start-size))
(with-tramp-connection-property (tramp-get-process vec) prop
(tramp-find-inline-compress vec)
- (tramp-get-connection-property (tramp-get-process vec) prop nil))))
+ (tramp-get-connection-property (tramp-get-process vec) prop))))
(defun tramp-get-inline-coding (vec prop size)
"Return the coding command related to PROP.
@@ -5899,7 +6032,7 @@ function cell is returned to be applied on a buffer."
(let ((coding
(with-tramp-connection-property (tramp-get-process vec) prop
(tramp-find-inline-encoding vec)
- (tramp-get-connection-property (tramp-get-process vec) prop nil)))
+ (tramp-get-connection-property (tramp-get-process vec) prop)))
(prop1 (if (tramp-compat-string-search "encoding" prop)
"inline-compress" "inline-decompress"))
compress)
@@ -6015,9 +6148,6 @@ function cell is returned to be applied on a buffer."
;;
;; * Use lsh instead of ssh. (Alfred M. Szmidt)
;;
-;; * Optimize out-of-band copying when both methods are scp-like (not
-;; rsync).
-;;
;; * Keep a second connection open for out-of-band methods like scp or
;; rsync.
;;
@@ -6061,5 +6191,8 @@ function cell is returned to be applied on a buffer."
;; be to stipulate, as a directory or connection-local variable, an
;; additional rc file on the remote machine that is sourced every
;; time Tramp connects. <https://emacs.stackexchange.com/questions/62306>
+;;
+;; * Support hostname canonicalization in ~/.ssh/config.
+;; <https://stackoverflow.com/questions/70205232/>
;;; tramp-sh.el ends here
diff --git a/tramp-smb.el b/tramp-smb.el
index dfcb7162c8..cd73b9b8ec 100644
--- a/tramp-smb.el
+++ b/tramp-smb.el
@@ -53,7 +53,7 @@
;;;###tramp-autoload
(tramp--with-startup
(add-to-list 'tramp-default-user-alist
- `(,(concat "\\`" tramp-smb-method "\\'") nil nil))
+ `(,(tramp-compat-rx bos (literal tramp-smb-method) eos) nil nil))
;; Add completion function for SMB method.
(tramp-set-completion-function
@@ -92,79 +92,79 @@ this variable \"client min protocol=NT1\"."
"Version string of the SMB client.")
(defconst tramp-smb-server-version
- "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]"
+ (tramp-compat-rx "Domain=[" (* (not "]")) "] "
+ "OS=[" (* (not "]")) "] "
+ "Server=[" (* (not "]")) "]")
"Regexp of SMB server identification.")
-(defconst tramp-smb-prompt "^\\(smb:\\|PS\\) .+> \\|^\\s-+Server\\s-+Comment$"
+(defconst tramp-smb-prompt
+ (rx bol (| (: (| "smb:" "PS") blank (+ nonl) "> ")
+ (: (+ blank) "Server"
+ (+ blank) "Comment" eol)))
"Regexp used as prompt in smbclient or powershell.")
(defconst tramp-smb-wrong-passwd-regexp
- (regexp-opt
- '("NT_STATUS_LOGON_FAILURE"
- "NT_STATUS_WRONG_PASSWORD"))
+ (rx (| "NT_STATUS_LOGON_FAILURE"
+ "NT_STATUS_WRONG_PASSWORD"))
"Regexp for login error strings of SMB servers.")
(defconst tramp-smb-errors
- (mapconcat
- #'identity
- `(;; Connection error / timeout / unknown command.
- "Connection\\( to \\S-+\\)? failed"
- "Read from server failed, maybe it closed the connection"
- "Call timed out: server did not respond"
- "\\S-+: command not found"
- "Server doesn't support UNIX CIFS calls"
- ,(regexp-opt
- '(;; Samba.
- "ERRDOS"
- "ERRHRD"
- "ERRSRV"
- "ERRbadfile"
- "ERRbadpw"
- "ERRfilexists"
- "ERRnoaccess"
- "ERRnomem"
- "ERRnosuchshare"
- ;; See /usr/include/samba-4.0/core/ntstatus.h.
- ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000),
- ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003),
- ;; Windows 6.0 (Windows Vista), Windows 6.1 (Windows 7),
- ;; Windows 6.3 (Windows Server 2012, Windows 10).
- "NT_STATUS_ACCESS_DENIED"
- "NT_STATUS_ACCOUNT_LOCKED_OUT"
- "NT_STATUS_BAD_NETWORK_NAME"
- "NT_STATUS_CANNOT_DELETE"
- "NT_STATUS_CONNECTION_DISCONNECTED"
- "NT_STATUS_CONNECTION_REFUSED"
- "NT_STATUS_CONNECTION_RESET"
- "NT_STATUS_DIRECTORY_NOT_EMPTY"
- "NT_STATUS_DUPLICATE_NAME"
- "NT_STATUS_FILE_IS_A_DIRECTORY"
- "NT_STATUS_HOST_UNREACHABLE"
- "NT_STATUS_IMAGE_ALREADY_LOADED"
- "NT_STATUS_INVALID_LEVEL"
- "NT_STATUS_INVALID_PARAMETER"
- "NT_STATUS_INVALID_PARAMETER_MIX"
- "NT_STATUS_IO_TIMEOUT"
- "NT_STATUS_LOGON_FAILURE"
- "NT_STATUS_NETWORK_ACCESS_DENIED"
- "NT_STATUS_NOT_IMPLEMENTED"
- "NT_STATUS_NO_LOGON_SERVERS"
- "NT_STATUS_NO_SUCH_FILE"
- "NT_STATUS_NO_SUCH_USER"
- "NT_STATUS_NOT_A_DIRECTORY"
- "NT_STATUS_NOT_SUPPORTED"
- "NT_STATUS_OBJECT_NAME_COLLISION"
- "NT_STATUS_OBJECT_NAME_INVALID"
- "NT_STATUS_OBJECT_NAME_NOT_FOUND"
- "NT_STATUS_OBJECT_PATH_SYNTAX_BAD"
- "NT_STATUS_PASSWORD_MUST_CHANGE"
- "NT_STATUS_RESOURCE_NAME_NOT_FOUND"
- "NT_STATUS_REVISION_MISMATCH"
- "NT_STATUS_SHARING_VIOLATION"
- "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE"
- "NT_STATUS_UNSUCCESSFUL"
- "NT_STATUS_WRONG_PASSWORD")))
- "\\|")
+ (rx (| ;; Connection error / timeout / unknown command.
+ (: "Connection" (? " to " (+ (not blank))) " failed")
+ "Read from server failed, maybe it closed the connection"
+ "Call timed out: server did not respond"
+ (: (+ (not blank)) ": command not found")
+ "Server doesn't support UNIX CIFS calls"
+ (| ;; Samba.
+ "ERRDOS"
+ "ERRHRD"
+ "ERRSRV"
+ "ERRbadfile"
+ "ERRbadpw"
+ "ERRfilexists"
+ "ERRnoaccess"
+ "ERRnomem"
+ "ERRnosuchshare"
+ ;; See /usr/include/samba-4.0/core/ntstatus.h.
+ ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000),
+ ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003),
+ ;; Windows 6.0 (Windows Vista), Windows 6.1 (Windows 7),
+ ;; Windows 6.3 (Windows Server 2012, Windows 10).
+ "NT_STATUS_ACCESS_DENIED"
+ "NT_STATUS_ACCOUNT_LOCKED_OUT"
+ "NT_STATUS_BAD_NETWORK_NAME"
+ "NT_STATUS_CANNOT_DELETE"
+ "NT_STATUS_CONNECTION_DISCONNECTED"
+ "NT_STATUS_CONNECTION_REFUSED"
+ "NT_STATUS_CONNECTION_RESET"
+ "NT_STATUS_DIRECTORY_NOT_EMPTY"
+ "NT_STATUS_DUPLICATE_NAME"
+ "NT_STATUS_FILE_IS_A_DIRECTORY"
+ "NT_STATUS_HOST_UNREACHABLE"
+ "NT_STATUS_IMAGE_ALREADY_LOADED"
+ "NT_STATUS_INVALID_LEVEL"
+ "NT_STATUS_INVALID_PARAMETER"
+ "NT_STATUS_INVALID_PARAMETER_MIX"
+ "NT_STATUS_IO_TIMEOUT"
+ "NT_STATUS_LOGON_FAILURE"
+ "NT_STATUS_NETWORK_ACCESS_DENIED"
+ "NT_STATUS_NOT_IMPLEMENTED"
+ "NT_STATUS_NO_LOGON_SERVERS"
+ "NT_STATUS_NO_SUCH_FILE"
+ "NT_STATUS_NO_SUCH_USER"
+ "NT_STATUS_NOT_A_DIRECTORY"
+ "NT_STATUS_NOT_SUPPORTED"
+ "NT_STATUS_OBJECT_NAME_COLLISION"
+ "NT_STATUS_OBJECT_NAME_INVALID"
+ "NT_STATUS_OBJECT_NAME_NOT_FOUND"
+ "NT_STATUS_OBJECT_PATH_SYNTAX_BAD"
+ "NT_STATUS_PASSWORD_MUST_CHANGE"
+ "NT_STATUS_RESOURCE_NAME_NOT_FOUND"
+ "NT_STATUS_REVISION_MISMATCH"
+ "NT_STATUS_SHARING_VIOLATION"
+ "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE"
+ "NT_STATUS_UNSUCCESSFUL"
+ "NT_STATUS_WRONG_PASSWORD")))
"Regexp for possible error strings of SMB servers.
Used instead of analyzing error codes of commands.")
@@ -222,7 +222,8 @@ See `tramp-actions-before-shell' for more info.")
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-smb-file-name-handler-alist
- '((access-file . tramp-handle-access-file)
+ '((abbreviate-file-name . tramp-handle-abbreviate-file-name)
+ (access-file . tramp-handle-access-file)
(add-name-to-file . tramp-smb-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
(copy-directory . tramp-smb-handle-copy-directory)
@@ -231,7 +232,7 @@ See `tramp-actions-before-shell' for more info.")
(delete-file . tramp-smb-handle-delete-file)
;; `diff-latest-backup-file' performed by default handler.
(directory-file-name . tramp-handle-directory-file-name)
- (directory-files . tramp-smb-handle-directory-files)
+ (directory-files . tramp-handle-directory-files)
(directory-files-and-attributes
. tramp-handle-directory-files-and-attributes)
(dired-compress-file . ignore)
@@ -273,15 +274,18 @@ See `tramp-actions-before-shell' for more info.")
;; `get-file-buffer' performed by default handler.
(insert-directory . tramp-smb-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
+ (list-system-processes . ignore)
(load . tramp-handle-load)
(lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-smb-handle-make-directory)
- (make-directory-internal . tramp-smb-handle-make-directory-internal)
+ (make-directory-internal . ignore)
(make-lock-file-name . tramp-handle-make-lock-file-name)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
(make-symbolic-link . tramp-smb-handle-make-symbolic-link)
+ (memory-info . ignore)
+ (process-attributes . ignore)
(process-file . tramp-smb-handle-process-file)
(rename-file . tramp-smb-handle-rename-file)
(set-file-acl . tramp-smb-handle-set-file-acl)
@@ -293,7 +297,9 @@ See `tramp-actions-before-shell' for more info.")
(start-file-process . tramp-smb-handle-start-file-process)
(substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-home-directory . tramp-smb-handle-get-home-directory)
(tramp-get-remote-gid . ignore)
+ (tramp-get-remote-groups . ignore)
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
@@ -330,11 +336,10 @@ This can be used to disable echo etc."
;; It must be a `defsubst' in order to push the whole code into
;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
;;;###tramp-autoload
-(defsubst tramp-smb-file-name-p (filename)
- "Check if it's a FILENAME for SMB servers."
- (and (tramp-tramp-file-p filename)
- (string= (tramp-file-name-method (tramp-dissect-file-name filename))
- tramp-smb-method)))
+(defsubst tramp-smb-file-name-p (vec-or-filename)
+ "Check if it's a VEC-OR-FILENAME for SMB servers."
+ (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
+ (string= (tramp-file-name-method vec) tramp-smb-method)))
;;;###tramp-autoload
(defun tramp-smb-file-name-handler (operation &rest args)
@@ -383,14 +388,13 @@ arguments to pass to the OPERATION."
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-properties v2 v2-localname)
- (unless
- (tramp-smb-send-command
- v1
- (format
- "%s \"%s\" \"%s\""
- (if (tramp-smb-get-cifs-capabilities v1) "link" "hardlink")
- (tramp-smb-get-localname v1)
- (tramp-smb-get-localname v2)))
+ (unless (tramp-smb-send-command
+ v1
+ (format
+ "%s %s %s"
+ (if (tramp-smb-get-cifs-capabilities v1) "link" "hardlink")
+ (tramp-smb-shell-quote-localname v1)
+ (tramp-smb-shell-quote-localname v2)))
(tramp-error
v2 'file-error
"error with add-name-to-file, see buffer `%s' for details"
@@ -414,176 +418,181 @@ arguments to pass to the OPERATION."
(defun tramp-smb-handle-copy-directory
(dirname newname &optional keep-date parents copy-contents)
"Like `copy-directory' for Tramp files."
- (let ((t1 (tramp-tramp-file-p dirname))
- (t2 (tramp-tramp-file-p newname))
- target)
- (with-parsed-tramp-file-name (if t1 dirname newname) nil
- (unless (file-exists-p dirname)
- (tramp-compat-file-missing v dirname))
-
- ;; `copy-directory-create-symlink' exists since Emacs 28.1.
- (if (and (bound-and-true-p copy-directory-create-symlink)
- (setq target (file-symlink-p dirname))
- (tramp-equal-remote dirname newname))
- (make-symbolic-link
- target
- (if (directory-name-p newname)
- (concat newname (file-name-nondirectory dirname)) newname)
- t)
-
- (if copy-contents
- ;; We must do it file-wise.
- (tramp-run-real-handler
- #'copy-directory
- (list dirname newname keep-date parents copy-contents))
-
- (setq dirname (expand-file-name dirname)
- newname (expand-file-name newname))
- (with-tramp-progress-reporter
- v 0 (format "Copying %s to %s" dirname newname)
- (unless (file-exists-p dirname)
- (tramp-compat-file-missing v dirname))
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-already-exists newname))
- (cond
- ;; We must use a local temporary directory.
- ((and t1 t2)
- (let ((tmpdir (tramp-compat-make-temp-name)))
- (unwind-protect
- (progn
- (make-directory tmpdir)
- (copy-directory
- dirname (file-name-as-directory tmpdir)
- keep-date 'parents)
- (copy-directory
- (expand-file-name (file-name-nondirectory dirname)
tmpdir)
- newname keep-date parents))
- (delete-directory tmpdir 'recursive))))
-
- ;; We can copy recursively.
- ;; TODO: Does not work reliably.
- (nil ;(and (or t1 t2) (tramp-smb-get-cifs-capabilities v))
+ (tramp-skeleton-copy-directory
+ dirname newname keep-date parents copy-contents
+ (let ((t1 (tramp-tramp-file-p dirname))
+ (t2 (tramp-tramp-file-p newname))
+ target)
+ (with-parsed-tramp-file-name (if t1 dirname newname) nil
+ (unless (file-exists-p dirname)
+ (tramp-error v 'file-missing dirname))
+
+ ;; `copy-directory-create-symlink' exists since Emacs 28.1.
+ (if (and (bound-and-true-p copy-directory-create-symlink)
+ (setq target (file-symlink-p dirname))
+ (tramp-equal-remote dirname newname))
+ (make-symbolic-link
+ target
+ (if (directory-name-p newname)
+ (concat newname (file-name-nondirectory dirname)) newname)
+ t)
+
+ (if copy-contents
+ ;; We must do it file-wise.
+ (tramp-run-real-handler
+ #'copy-directory
+ (list dirname newname keep-date parents copy-contents))
+
+ (setq dirname (expand-file-name dirname)
+ newname (expand-file-name newname))
+ (with-tramp-progress-reporter
+ v 0 (format "Copying %s to %s" dirname newname)
(when (and (file-directory-p newname)
- (not (string-equal (file-name-nondirectory dirname)
- (file-name-nondirectory newname))))
- (setq newname
- (expand-file-name
- (file-name-nondirectory dirname) newname))
- (if t2 (setq v (tramp-dissect-file-name newname))))
- (if (not (file-directory-p newname))
- (make-directory newname parents))
-
- (let* ((share (tramp-smb-get-share v))
- (localname (file-name-as-directory
- (tramp-compat-string-replace
- "\\" "/" (tramp-smb-get-localname v))))
- (tmpdir (tramp-compat-make-temp-name))
- (args (list (concat "//" host "/" share) "-E"))
- (options tramp-smb-options))
-
- (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))))
- (when port (setq args (append args (list "-p" port))))
- (when tramp-smb-conf
- (setq args (append args (list "-s" tramp-smb-conf))))
- (while options
- (setq args
- (append args `("--option" ,(format "%s" (car options))))
- options (cdr options)))
- (setq args
- (if t1
- ;; Source is remote.
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-already-exists newname))
+ (cond
+ ;; We must use a local temporary directory.
+ ((and t1 t2)
+ (let ((tmpdir (tramp-compat-make-temp-name)))
+ (unwind-protect
+ (progn
+ (make-directory tmpdir)
+ (copy-directory
+ dirname (file-name-as-directory tmpdir)
+ keep-date 'parents)
+ (copy-directory
+ (expand-file-name
+ (file-name-nondirectory dirname) tmpdir)
+ newname keep-date parents))
+ (delete-directory tmpdir 'recursive))))
+
+ ;; We can copy recursively.
+ ;; FIXME: Does not work reliably.
+ (nil ;(and (or t1 t2) (tramp-smb-get-cifs-capabilities v))
+ (when (and (file-directory-p newname)
+ (not (string-equal (file-name-nondirectory dirname)
+ (file-name-nondirectory
newname))))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory dirname) newname))
+ (if t2 (setq v (tramp-dissect-file-name newname))))
+ (if (not (file-directory-p newname))
+ (make-directory newname parents))
+
+ (let* ((share (tramp-smb-get-share v))
+ (localname (file-name-as-directory
+ (tramp-compat-string-replace
+ "\\" "/" (tramp-smb-get-localname v))))
+ (tmpdir (tramp-compat-make-temp-name))
+ (args (list (concat "//" host "/" share) "-E"))
+ (options tramp-smb-options))
+
+ (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))))
+ (when port (setq args (append args (list "-p" port))))
+ (when tramp-smb-conf
+ (setq args (append args (list "-s" tramp-smb-conf))))
+ (while options
+ (setq args
(append args
+ `("--option" ,(format "%s" (car options))))
+ options (cdr options)))
+ (setq args
+ (if t1
+ ;; Source is remote.
+ (append args
+ (list "-D"
+ (tramp-unquote-shell-quote-argument
+ localname)
+ "-c"
+ (tramp-unquote-shell-quote-argument
+ "tar qc - *")
+ "|" "tar" "xfC" "-"
+ (tramp-unquote-shell-quote-argument
+ tmpdir)))
+ ;; Target is remote.
+ (append (list
+ "tar" "cfC" "-"
+ (tramp-unquote-shell-quote-argument dirname)
+ "." "|")
+ args
(list "-D" (tramp-unquote-shell-quote-argument
localname)
"-c" (tramp-unquote-shell-quote-argument
- "tar qc - *")
- "|" "tar" "xfC" "-"
- (tramp-unquote-shell-quote-argument
- tmpdir)))
- ;; Target is remote.
- (append (list
- "tar" "cfC" "-"
- (tramp-unquote-shell-quote-argument dirname)
- "." "|")
- args
- (list "-D" (tramp-unquote-shell-quote-argument
- localname)
- "-c" (tramp-unquote-shell-quote-argument
- "tar qx -")))))
-
- (unwind-protect
- (with-temp-buffer
- ;; Set the transfer process properties.
- (tramp-set-connection-property
- v "process-name" (buffer-name (current-buffer)))
- (tramp-set-connection-property
- v "process-buffer" (current-buffer))
-
- (when t1
- ;; The smbclient tar command creates always
- ;; complete paths. We must emulate the
- ;; directory structure, and symlink to the
- ;; real target.
- (make-directory
- (expand-file-name
- ".." (concat tmpdir localname))
- 'parents)
- (make-symbolic-link
- newname
- (directory-file-name (concat tmpdir localname))))
-
- ;; Use an asynchronous processes. By this,
- ;; password can be handled.
- (let* ((default-directory tmpdir)
- (p (apply
- #'start-process
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- tramp-smb-program args)))
-
- (tramp-message
- v 6 "%s" (string-join (process-command p) " "))
- (process-put p 'vector v)
- (process-put p 'adjust-window-size-function #'ignore)
- (set-process-query-on-exit-flag p nil)
- (tramp-process-actions
- p v nil tramp-smb-actions-with-tar)
-
- (while (process-live-p p)
- (sleep-for 0.1))
- (tramp-message v 6 "\n%s" (buffer-string))))
-
- ;; Reset the transfer process properties.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")
- (when t1 (delete-directory tmpdir 'recursive))))
-
- ;; Handle KEEP-DATE argument.
- (when keep-date
- (tramp-compat-set-file-times
- newname
- (tramp-compat-file-attribute-modification-time
- (file-attributes dirname))
- (unless ok-if-already-exists 'nofollow)))
-
- ;; Set the mode.
- (unless keep-date
- (set-file-modes newname (tramp-default-file-modes dirname)))
-
- ;; When newname did exist, we have wrong cached values.
- (when t2
- (with-parsed-tramp-file-name newname nil
- (tramp-flush-file-properties v localname))))
-
- ;; We must do it file-wise.
- (t
- (tramp-run-real-handler
- #'copy-directory (list dirname newname keep-date
parents))))))))))
+ "tar qx -")))))
+
+ (unwind-protect
+ (with-tramp-saved-connection-properties
+ v '("process-name" "process-buffer")
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ (when t1
+ ;; The smbclient tar command creates
+ ;; always complete paths. We must emulate
+ ;; the directory structure, and symlink to
+ ;; the real target.
+ (make-directory
+ (expand-file-name
+ ".." (concat tmpdir localname))
+ 'parents)
+ (make-symbolic-link
+ newname
+ (directory-file-name (concat tmpdir localname))))
+
+ ;; Use an asynchronous processes. By this,
+ ;; password can be handled.
+ (let* ((default-directory tmpdir)
+ (p (apply
+ #'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-program args)))
+
+ (tramp-message
+ v 6 "%s" (string-join (process-command p) " "))
+ (process-put p 'vector v)
+ (process-put
+ p 'adjust-window-size-function #'ignore)
+ (set-process-query-on-exit-flag p nil)
+ (tramp-process-actions
+ p v nil tramp-smb-actions-with-tar)
+
+ (while (process-live-p p)
+ (sleep-for 0.1))
+ (tramp-message v 6 "\n%s" (buffer-string)))))
+
+ ;; Save exit.
+ (when t1 (delete-directory tmpdir 'recursive))))
+
+ ;; Handle KEEP-DATE argument.
+ (when keep-date
+ (tramp-compat-set-file-times
+ newname
+ (file-attribute-modification-time (file-attributes dirname))
+ (unless ok-if-already-exists 'nofollow)))
+
+ ;; Set the mode.
+ (unless keep-date
+ (set-file-modes newname (tramp-default-file-modes dirname)))
+
+ ;; When newname did exist, we have wrong cached values.
+ (when t2
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-properties v localname))))
+
+ ;; We must do it file-wise.
+ (t
+ (tramp-run-real-handler
+ #'copy-directory
+ (list dirname newname keep-date parents)))))))))))
(defun tramp-smb-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
@@ -602,12 +611,16 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(copy-directory filename newname keep-date 'parents 'copy-contents)
(unless (file-exists-p filename)
- (tramp-compat-file-missing
+ (tramp-error
(tramp-dissect-file-name
(if (tramp-tramp-file-p filename) filename newname))
- filename))
+ 'file-missing filename))
- (if-let ((tmpfile (file-local-copy filename)))
+ ;; `file-local-copy' returns a file name also for a local file
+ ;; with `jka-compr-handler', so we cannot trust its result as
+ ;; indication for a remote file name.
+ (if-let ((tmpfile
+ (and (file-remote-p filename) (file-local-copy filename))))
;; Remote filename.
(condition-case err
(rename-file tmpfile newname ok-if-already-exists)
@@ -635,9 +648,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(tramp-error
v 'file-error "Target `%s' must contain a share name" newname))
(unless (tramp-smb-send-command
- v (format "put \"%s\" \"%s\""
- (tramp-compat-file-name-unquote filename)
- (tramp-smb-get-localname v)))
+ v (format "put %s %s"
+ (tramp-smb-shell-quote-argument filename)
+ (tramp-smb-shell-quote-localname v)))
(tramp-error
v 'file-error "Cannot copy `%s' to `%s'" filename newname)))))
@@ -645,8 +658,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(when keep-date
(tramp-compat-set-file-times
newname
- (tramp-compat-file-attribute-modification-time
- (file-attributes filename))
+ (file-attribute-modification-time (file-attributes filename))
(unless ok-if-already-exists 'nofollow)))))
(defun tramp-smb-handle-delete-directory (directory &optional recursive trash)
@@ -667,10 +679,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(tramp-flush-directory-properties v localname)
(unless (tramp-smb-send-command
v (format
- "%s \"%s\""
+ "%s %s"
(if (tramp-smb-get-cifs-capabilities v)
"posix_rmdir" "rmdir")
- (tramp-smb-get-localname v)))
+ (tramp-smb-shell-quote-localname v)))
;; Error.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
@@ -693,46 +705,15 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(move-file-to-trash filename)
(unless (tramp-smb-send-command
v (format
- "%s \"%s\""
+ "%s %s"
(if (tramp-smb-get-cifs-capabilities v) "posix_unlink" "rm")
- (tramp-smb-get-localname v)))
+ (tramp-smb-shell-quote-localname v)))
;; Error.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(search-forward-regexp tramp-smb-errors nil t)
(tramp-error v 'file-error "%s `%s'" (match-string 0)
filename)))))))
-(defun tramp-smb-handle-directory-files
- (directory &optional full match nosort count)
- "Like `directory-files' for Tramp files."
- (unless (file-exists-p directory)
- (tramp-compat-file-missing (tramp-dissect-file-name directory) directory))
- (let ((result (mapcar #'directory-file-name
- (file-name-all-completions "" directory))))
- ;; Discriminate with regexp.
- (when match
- (setq result
- (delete nil
- (mapcar (lambda (x) (when (string-match-p match x) x))
- result))))
-
- ;; Sort them if necessary.
- (unless nosort
- (setq result (sort result #'string-lessp)))
-
- ;; Return count number of results.
- (when (and (natnump count) (> count 0))
- (setq result (nbutlast result (- (length result) count))))
-
- ;; Prepend directory.
- (when full
- (setq result
- (mapcar
- (lambda (x) (format "%s/%s" (directory-file-name directory) x))
- result)))
-
- result))
-
(defun tramp-smb-handle-expand-file-name (name &optional dir)
"Like `expand-file-name' for Tramp files."
;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
@@ -744,28 +725,39 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(setq name (tramp-compat-file-name-concat dir name)))
;; If NAME is not a Tramp file, run the real handler.
(if (not (tramp-tramp-file-p name))
- (tramp-run-real-handler #'expand-file-name (list name nil))
+ (tramp-run-real-handler #'expand-file-name (list name))
;; Dissect NAME.
(with-parsed-tramp-file-name name nil
- ;; Tilde expansion if necessary. We use the user name as share,
- ;; which is often the case in domains.
- (when (string-match "\\`/?~\\([^/]*\\)" localname)
- (setq localname
- (replace-match
- (if (zerop (length (match-string 1 localname)))
- user
- (match-string 1 localname))
- nil nil localname)))
- ;; Make the file name absolute.
+ ;; Tilde expansion if necessary.
+ (when (string-match
+ (tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl))
eos)
+ localname)
+ (let ((uname (match-string 1 localname))
+ (fname (match-string 2 localname))
+ hname)
+ (when (zerop (length uname))
+ (setq uname user))
+ (when (setq hname (tramp-get-home-directory v uname))
+ (setq localname (concat hname fname)))))
+ ;; Tilde expansion is not possible.
+ (when (and (not tramp-tolerate-tilde)
+ (string-prefix-p "~" localname))
+ (tramp-error v 'file-error "Cannot expand tilde in file `%s'" name))
(unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
(setq localname (concat "/" localname)))
;; Do not keep "/..".
- (when (string-match-p "^/\\.\\.?$" localname)
+ (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname)
(setq localname "/"))
- ;; No tilde characters in file name, do normal
- ;; `expand-file-name' (this does "/./" and "/../").
+ ;; Do normal `expand-file-name' (this does "/./" and "/../"),
+ ;; unless there are tilde characters in file name.
(tramp-make-tramp-file-name
- v (tramp-run-real-handler #'expand-file-name (list localname))))))
+ v (if (string-prefix-p "~" localname)
+ localname
+ (tramp-run-real-handler #'expand-file-name (list localname)))))))
+
+(defun tramp-smb-remote-acl-p (_vec)
+ "Check, whether ACL is enabled on the remote host."
+ (and (stringp tramp-smb-acl-program) (executable-find
tramp-smb-acl-program)))
(defun tramp-smb-action-get-acl (proc vec)
"Read ACL data from connection buffer."
@@ -777,10 +769,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(widen)
(tramp-message vec 10 "\n%s" (buffer-string))
(goto-char (point-min))
- (while (and (not (eobp)) (not (looking-at-p "^REVISION:")))
+ (while (and (not (eobp)) (not (looking-at-p (rx bol "REVISION:"))))
(forward-line)
(delete-region (point-min) (point)))
- (while (and (not (eobp)) (looking-at-p "^.+:.+"))
+ (while (and (not (eobp)) (looking-at-p (rx bol (+ nonl) ":" (+ nonl))))
(forward-line))
(delete-region (point) (point-max))
(throw 'tramp-action 'ok))))
@@ -790,7 +782,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(ignore-errors
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-acl"
- (when (executable-find tramp-smb-acl-program)
+ (when (tramp-smb-remote-acl-p v)
(let* ((share (tramp-smb-get-share v))
(localname (tramp-compat-string-replace
"\\" "/" (tramp-smb-get-localname v)))
@@ -815,54 +807,49 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(concat "2>" (tramp-get-remote-null-device
v)))))
(unwind-protect
- (with-temp-buffer
- ;; Set the transfer process properties.
- (tramp-set-connection-property
- v "process-name" (buffer-name (current-buffer)))
- (tramp-set-connection-property
- v "process-buffer" (current-buffer))
-
- ;; Use an asynchronous process. By this, password can
- ;; be handled.
- (let ((p (apply
- #'start-process
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- tramp-smb-acl-program args)))
-
- (tramp-message
- v 6 "%s" (string-join (process-command p) " "))
- (process-put p 'vector v)
- (process-put p 'adjust-window-size-function #'ignore)
- (set-process-query-on-exit-flag p nil)
- (tramp-process-actions p v nil tramp-smb-actions-get-acl)
- (when (> (point-max) (point-min))
- (substring-no-properties (buffer-string)))))
-
- ;; Reset the transfer process properties.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer"))))))))
+ (with-tramp-saved-connection-properties
+ v '("process-name" "process-buffer")
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ ;; Use an asynchronous process. By this, password
+ ;; can be handled.
+ (let ((p (apply
+ #'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-acl-program args)))
+
+ (tramp-message
+ v 6 "%s" (string-join (process-command p) " "))
+ (process-put p 'vector v)
+ (process-put p 'adjust-window-size-function #'ignore)
+ (set-process-query-on-exit-flag p nil)
+ (tramp-process-actions p v nil tramp-smb-actions-get-acl)
+ (when (> (point-max) (point-min))
+ (substring-no-properties (buffer-string)))))))))))))
(defun tramp-smb-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
- (unless id-format (setq id-format 'integer))
- (ignore-errors
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property
- v localname (format "file-attributes-%s" id-format)
+ ;; The result is cached in `tramp-convert-file-attributes'.
+ (with-parsed-tramp-file-name filename nil
+ (tramp-convert-file-attributes v localname id-format
+ (ignore-errors
(if (tramp-smb-get-stat-capability v)
- (tramp-smb-do-file-attributes-with-stat v id-format)
- ;; Reading just the filename entry via "dir localname" is not
- ;; possible, because when filename is a directory, some
- ;; smbclient versions return the content of the directory, and
- ;; other versions don't. Therefore, the whole content of the
- ;; upper directory is retrieved, and the entry of the filename
- ;; is extracted from.
+ (tramp-smb-do-file-attributes-with-stat v)
+ ;; Reading just the filename entry via "dir localname" is
+ ;; not possible, because when filename is a directory, some
+ ;; smbclient versions return the content of the directory,
+ ;; and other versions don't. Therefore, the whole content
+ ;; of the upper directory is retrieved, and the entry of the
+ ;; filename is extracted from.
(let* ((entries (tramp-smb-get-file-entries
(file-name-directory filename)))
(entry (assoc (file-name-nondirectory filename) entries))
- (uid (if (equal id-format 'string) "nobody" -1))
- (gid (if (equal id-format 'string) "nogroup" -1))
(inode (tramp-get-inode v))
(device (tramp-get-device v)))
@@ -870,25 +857,27 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(when entry
(list (and (tramp-compat-string-search "d" (nth 1 entry))
t) ;0 file type
- -1 ;1 link count
- uid ;2 uid
- gid ;3 gid
+ -1 ;1 link count
+ (cons
+ tramp-unknown-id-string tramp-unknown-id-integer) ;2 uid
+ (cons
+ tramp-unknown-id-string tramp-unknown-id-integer) ;3 gid
tramp-time-dont-know ;4 atime
(nth 3 entry) ;5 mtime
tramp-time-dont-know ;6 ctime
(nth 2 entry) ;7 size
(nth 1 entry) ;8 mode
- nil ;9 gid weird
- inode ;10 inode number
+ nil ;9 gid weird
+ inode ;10 inode number
device)))))))) ;11 file system number
-(defun tramp-smb-do-file-attributes-with-stat (vec &optional id-format)
+(defun tramp-smb-do-file-attributes-with-stat (vec)
"Implement `file-attributes' for Tramp files using `stat' command."
(tramp-message
vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec))
(let* (size id link uid gid atime mtime ctime mode inode)
(when (tramp-smb-send-command
- vec (format "stat \"%s\"" (tramp-smb-get-localname vec)))
+ vec (format "stat %s" (tramp-smb-shell-quote-localname vec)))
;; Loop the listing.
(with-current-buffer (tramp-get-connection-buffer vec)
@@ -897,31 +886,30 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(while (not (eobp))
(cond
((looking-at
- (concat
- "Size:\\s-+\\([[:digit:]]+\\)\\s-+"
- "Blocks:\\s-+[[:digit:]]+\\s-+\\(\\w+\\)"))
+ (rx "Size:" (+ blank) (group (+ digit)) (+ blank)
+ "Blocks:" (+ blank) (+ digit) (+ blank) (group (+
wordchar))))
(setq size (string-to-number (match-string 1))
id (if (string-equal "directory" (match-string 2)) t
(if (string-equal "symbolic" (match-string 2)) ""))))
((looking-at
-
"Inode:\\s-+\\([[:digit:]]+\\)\\s-+Links:\\s-+\\([[:digit:]]+\\)")
+ (rx "Inode:" (+ blank) (group (+ digit)) (+ blank)
+ "Links:" (+ blank) (group (+ digit))))
(setq inode (string-to-number (match-string 1))
link (string-to-number (match-string 2))))
((looking-at
- (concat
- "Access:\\s-+([[:digit:]]+/\\(\\S-+\\))\\s-+"
- "Uid:\\s-+\\([[:digit:]]+\\)\\s-+"
- "Gid:\\s-+\\([[:digit:]]+\\)"))
+ (rx "Access:" (+ blank)
+ "(" (+ digit) "/" (group (+ (not blank))) ")" (+ blank)
+ "Uid:" (+ blank) (group (+ digit)) (+ blank)
+ "Gid:" (+ blank) (group (+ digit))))
(setq mode (match-string 1)
- uid (if (equal id-format 'string) (match-string 2)
- (string-to-number (match-string 2)))
- gid (if (equal id-format 'string) (match-string 3)
- (string-to-number (match-string 3)))))
+ uid (match-string 2)
+ gid (match-string 3)))
((looking-at
- (concat
- "Access:\\s-+"
- "\\([[:digit:]]+\\)-\\([[:digit:]]+\\)-\\([[:digit:]]+\\)\\s-+"
- "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)"))
+ (rx "Access:" (+ blank)
+ (group (+ digit)) "-" (group (+ digit)) "-"
+ (group (+ digit)) (+ blank)
+ (group (+ digit)) ":" (group (+ digit)) ":"
+ (group (+ digit))))
(setq atime
(encode-time
(string-to-number (match-string 6)) ;; sec
@@ -931,10 +919,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(string-to-number (match-string 2)) ;; month
(string-to-number (match-string 1))))) ;; year
((looking-at
- (concat
- "Modify:\\s-+"
- "\\([[:digit:]]+\\)-\\([[:digit:]]+\\)-\\([[:digit:]]+\\)\\s-+"
- "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)"))
+ (rx "Modify:" (+ blank)
+ (group (+ digit)) "-" (group (+ digit)) "-"
+ (group (+ digit)) (+ blank)
+ (group (+ digit)) ":" (group (+ digit)) ":"
+ (group (+ digit))))
(setq mtime
(encode-time
(string-to-number (match-string 6)) ;; sec
@@ -944,10 +933,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(string-to-number (match-string 2)) ;; month
(string-to-number (match-string 1))))) ;; year
((looking-at
- (concat
- "Change:\\s-+"
- "\\([[:digit:]]+\\)-\\([[:digit:]]+\\)-\\([[:digit:]]+\\)\\s-+"
- "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)"))
+ (rx "Change:" (+ blank)
+ (group (+ digit)) "-" (group (+ digit)) "-"
+ (group (+ digit)) (+ blank)
+ (group (+ digit)) ":" (group (+ digit)) ":"
+ (group (+ digit))))
(setq ctime
(encode-time
(string-to-number (match-string 6)) ;; sec
@@ -962,32 +952,31 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(when (and (stringp id)
(tramp-smb-send-command
vec
- (format "readlink \"%s\"" (tramp-smb-get-localname vec))))
+ (format
+ "readlink %s" (tramp-smb-shell-quote-localname vec))))
(goto-char (point-min))
- (and (looking-at ".+ -> \\(.+\\)")
+ (and (looking-at (rx (+ nonl) " -> " (group (+ nonl))))
(setq id (match-string 1))))
;; Return the result.
(when (or id link uid gid atime mtime ctime size mode inode)
- (list id link uid gid atime mtime ctime size mode nil inode
- (tramp-get-device vec))))))))
+ (list id link (cons uid (string-to-number uid))
+ (cons gid (string-to-number gid)) gid atime mtime ctime size
+ mode nil inode (tramp-get-device vec))))))))
(defun tramp-smb-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
- (with-parsed-tramp-file-name (file-truename filename) nil
- (unless (file-exists-p (file-truename filename))
- (tramp-compat-file-missing v filename))
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (with-tramp-progress-reporter
- v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
- (unless (tramp-smb-send-command
- v (format "get \"%s\" \"%s\""
- (tramp-smb-get-localname v) tmpfile))
- ;; Oops, an error. We shall cleanup.
- (delete-file tmpfile)
- (tramp-error
- v 'file-error "Cannot make local copy of file `%s'" filename)))
- tmpfile)))
+ (tramp-skeleton-file-local-copy filename
+ (with-tramp-progress-reporter
+ v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
+ (unless (tramp-smb-send-command
+ v (format "get %s %s"
+ (tramp-smb-shell-quote-localname v)
+ (tramp-smb-shell-quote-argument tmpfile)))
+ ;; Oops, an error. We shall cleanup.
+ (delete-file tmpfile)
+ (tramp-error
+ v 'file-error "Cannot make local copy of file `%s'" filename)))))
;; This function should return "foo/" for directories and "bar" for
;; files.
@@ -1015,20 +1004,20 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(when (tramp-smb-get-share v)
(tramp-message v 5 "file system info: %s" localname)
(tramp-smb-send-command
- v (format "du %s/*" (tramp-smb-get-localname v)))
+ v (format "du %s/*" (tramp-smb-shell-quote-localname v)))
(with-current-buffer (tramp-get-connection-buffer v)
(let (total avail blocksize)
(goto-char (point-min))
(forward-line)
(when (looking-at
- (concat "[[:space:]]*\\([[:digit:]]+\\)"
- " blocks of size \\([[:digit:]]+\\)"
- "\\. \\([[:digit:]]+\\) blocks available"))
+ (rx (* blank) (group (+ digit))
+ " blocks of size " (group (+ digit))
+ ". " (group (+ digit)) " blocks available"))
(setq blocksize (string-to-number (match-string 2))
total (* blocksize (string-to-number (match-string 1)))
avail (* blocksize (string-to-number (match-string 3)))))
(forward-line)
- (when (looking-at "Total number of bytes: \\([[:digit:]]+\\)")
+ (when (looking-at (rx "Total number of bytes: " (group (+ digit))))
;; The used number of bytes is not part of the result.
;; As side effect, we store it as file property.
(tramp-set-file-property
@@ -1041,8 +1030,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
"Like `file-writable-p' for Tramp files."
(if (file-exists-p filename)
(tramp-compat-string-search
- "w"
- (or (tramp-compat-file-attribute-modes (file-attributes filename)) ""))
+ "w" (or (file-attribute-modes (file-attributes filename)) ""))
(let ((dir (file-name-directory filename)))
(and (file-exists-p dir)
(file-writable-p dir)))))
@@ -1080,11 +1068,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(/ (tramp-get-file-property v localname "used-bytes" 0) 1024))))
(when wildcard
- (string-match "\\." base)
+ (string-match (rx ".") base)
(setq base (replace-match "\\\\." nil nil base))
- (string-match "\\*" base)
+ (string-match (rx "*") base)
(setq base (replace-match ".*" nil nil base))
- (string-match "\\?" base)
+ (string-match (rx "?") base)
(setq base (replace-match ".?" nil nil base)))
;; Filter entries.
@@ -1095,7 +1083,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; Check for matching entries.
(mapcar
(lambda (x)
- (when (string-match-p (format "^%s" base) (nth 0 x)) x))
+ (when (string-match-p
+ (tramp-compat-rx bol (literal base)) (nth 0 x))
+ x))
entries)
;; We just need the only and only entry FILENAME.
(list (assoc base entries)))))
@@ -1147,11 +1137,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(insert
(format
"%10s %3d %-8s %-8s %8s %s "
- (or (tramp-compat-file-attribute-modes attr) (nth 1 x))
- (or (tramp-compat-file-attribute-link-number attr) 1)
- (or (tramp-compat-file-attribute-user-id attr) "nobody")
- (or (tramp-compat-file-attribute-group-id attr) "nogroup")
- (or (tramp-compat-file-attribute-size attr) (nth 2 x))
+ (or (file-attribute-modes attr) (nth 1 x))
+ (or (file-attribute-link-number attr) 1)
+ (or (file-attribute-user-id attr) "nobody")
+ (or (file-attribute-group-id attr) "nogroup")
+ (or (file-attribute-size attr) (nth 2 x))
(format-time-string
(if (time-less-p
;; Half a year.
@@ -1173,8 +1163,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; Insert symlink.
(when (and (tramp-compat-string-search "l" switches)
- (stringp (tramp-compat-file-attribute-type attr)))
- (insert " -> " (tramp-compat-file-attribute-type attr))))
+ (stringp (file-attribute-type attr)))
+ (insert " -> " (file-attribute-type attr))))
(insert "\n")
(beginning-of-line)))
@@ -1196,28 +1186,36 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(make-directory ldir parents))
;; Just do it.
(when (file-directory-p ldir)
- (make-directory-internal dir))
+ (tramp-smb-send-command
+ v (if (tramp-smb-get-cifs-capabilities v)
+ (format "posix_mkdir %s %o"
+ (tramp-smb-shell-quote-localname v) (default-file-modes))
+ (format "mkdir %s" (tramp-smb-shell-quote-localname v))))
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-properties v localname))
(unless (file-directory-p dir)
(tramp-error v 'file-error "Couldn't make directory %s" dir)))))
+;; This is not used anymore.
(defun tramp-smb-handle-make-directory-internal (directory)
"Like `make-directory-internal' for Tramp files."
+ (declare (obsolete nil "29.1"))
(setq directory (directory-file-name (expand-file-name directory)))
(unless (file-name-absolute-p directory)
(setq directory (expand-file-name directory default-directory)))
(with-parsed-tramp-file-name directory nil
- (let* ((file (tramp-smb-get-localname v)))
- (when (file-directory-p (file-name-directory directory))
- (tramp-smb-send-command
- v
- (if (tramp-smb-get-cifs-capabilities v)
- (format "posix_mkdir \"%s\" %o" file (default-file-modes))
- (format "mkdir \"%s\"" file)))
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v localname))
- (unless (file-directory-p directory)
- (tramp-error v 'file-error "Couldn't make directory %s" directory)))))
+ (when (file-directory-p (file-name-directory directory))
+ (tramp-smb-send-command
+ v (if (tramp-smb-get-cifs-capabilities v)
+ (format "posix_mkdir %s %o"
+ (tramp-smb-shell-quote-localname v) (default-file-modes))
+ (format "mkdir %s" (tramp-smb-shell-quote-localname v))))
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-properties v localname))
+ (unless (file-directory-p directory)
+ (tramp-error v 'file-error "Couldn't make directory %s" directory))))
(defun tramp-smb-handle-make-symbolic-link
(target linkname &optional ok-if-already-exists)
@@ -1225,51 +1223,47 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
If TARGET is a non-Tramp file, it is used verbatim as the target
of the symlink. If TARGET is a Tramp file, only the localname
component is used as the target of the symlink."
- (if (not (tramp-tramp-file-p (expand-file-name linkname)))
- (tramp-run-real-handler
- #'make-symbolic-link (list target linkname ok-if-already-exists))
-
- (with-parsed-tramp-file-name linkname nil
- ;; If TARGET is a Tramp name, use just the localname component.
- ;; Don't check for a proper method.
- (let ((non-essential t))
- (when (and (tramp-tramp-file-p target)
- (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
- (setq target (tramp-file-local-name (expand-file-name target)))))
-
- ;; If TARGET is still remote, quote it.
- (if (tramp-tramp-file-p target)
- (make-symbolic-link (tramp-compat-file-name-quote target 'top)
- linkname ok-if-already-exists)
-
- ;; Do the 'confirm if exists' thing.
- (when (file-exists-p linkname)
- ;; What to do?
- (if (or (null ok-if-already-exists) ; not allowed to exist
- (and (numberp ok-if-already-exists)
- (not (yes-or-no-p
- (format
- "File %s already exists; make it a link anyway?"
- localname)))))
- (tramp-error v 'file-already-exists localname)
- (delete-file linkname)))
-
- (unless (tramp-smb-get-cifs-capabilities v)
- (tramp-error v 'file-error "make-symbolic-link not supported"))
+ (with-parsed-tramp-file-name linkname nil
+ ;; If TARGET is a Tramp name, use just the localname component.
+ ;; Don't check for a proper method.
+ (let ((non-essential t))
+ (when (and (tramp-tramp-file-p target)
+ (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
+ (setq target (tramp-file-local-name (expand-file-name target)))))
+
+ ;; If TARGET is still remote, quote it.
+ (if (tramp-tramp-file-p target)
+ (make-symbolic-link
+ (tramp-compat-file-name-quote target 'top)
+ linkname ok-if-already-exists)
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v localname)
+ ;; Do the 'confirm if exists' thing.
+ (when (file-exists-p linkname)
+ ;; What to do?
+ (if (or (null ok-if-already-exists) ; not allowed to exist
+ (and (numberp ok-if-already-exists)
+ (not (yes-or-no-p
+ (format
+ "File %s already exists; make it a link anyway?"
+ localname)))))
+ (tramp-error v 'file-already-exists localname)
+ (delete-file linkname)))
- (unless
- (tramp-smb-send-command
- v (format "symlink \"%s\" \"%s\""
- (tramp-compat-file-name-unquote target)
- (tramp-smb-get-localname v)))
- (tramp-error
- v 'file-error
- "error with make-symbolic-link, see buffer `%s' for details"
- (tramp-get-connection-buffer v)))))))
+ (unless (tramp-smb-get-cifs-capabilities v)
+ (tramp-error v 'file-error "make-symbolic-link not supported"))
+
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-properties v localname)
+
+ (unless (tramp-smb-send-command
+ v (format "symlink %s %s"
+ (tramp-smb-shell-quote-argument target)
+ (tramp-smb-shell-quote-localname v)))
+ (tramp-error
+ v 'file-error
+ "error with make-symbolic-link, see buffer `%s' for details"
+ (tramp-get-connection-buffer v))))))
(defun tramp-smb-handle-process-file
(program &optional infile destination display &rest args)
@@ -1334,31 +1328,34 @@ component is used as the target of the symlink."
(setq i (1+ i)
name1 (format "%s<%d>" name i)))
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name1)
- (tramp-set-connection-property
- v "process-buffer"
- (or outbuf (generate-new-buffer tramp-temp-buffer-name)))
-
;; Call it.
(condition-case nil
- (with-current-buffer (tramp-get-connection-buffer v)
- ;; Preserve buffer contents.
- (narrow-to-region (point-max) (point-max))
- (tramp-smb-call-winexe v)
- (when (tramp-smb-get-share v)
- (tramp-smb-send-command
- v (format "cd \"//%s%s\"" host (file-name-directory localname))))
- (tramp-smb-send-command v command)
- ;; Preserve command output.
- (narrow-to-region (point-max) (point-max))
- (let ((p (tramp-get-connection-process v)))
- (tramp-smb-send-command v "exit $lasterrorcode")
- (while (process-live-p p)
- (sleep-for 0.1)
- (setq ret (process-exit-status p))))
- (delete-region (point-min) (point-max))
- (widen))
+ (with-tramp-saved-connection-properties
+ v '("process-name" "process-buffer")
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name1)
+ (tramp-set-connection-property
+ v "process-buffer"
+ (or outbuf (generate-new-buffer tramp-temp-buffer-name)))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ ;; Preserve buffer contents.
+ (narrow-to-region (point-max) (point-max))
+ (tramp-smb-call-winexe v)
+ (when (tramp-smb-get-share v)
+ (tramp-smb-send-command
+ v (format "cd //%s%s" host
+ (tramp-smb-shell-quote-argument
+ (file-name-directory localname)))))
+ (tramp-smb-send-command v command)
+ ;; Preserve command output.
+ (narrow-to-region (point-max) (point-max))
+ (let ((p (tramp-get-connection-process v)))
+ (tramp-smb-send-command v "exit $lasterrorcode")
+ (while (process-live-p p)
+ (sleep-for 0.1)
+ (setq ret (process-exit-status p))))
+ (delete-region (point-min) (point-max))
+ (widen)))
;; When the user did interrupt, we should do it also. We use
;; return code -1 as marker.
@@ -1373,13 +1370,12 @@ component is used as the target of the symlink."
;; Cleanup. We remove all file cache values for the connection,
;; because the remote process could have changed them.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")
(when tmpinput (delete-file tmpinput))
+ ;; FIXME: Does connection-property "process-buffer" still exist?
(unless outbuf
- (kill-buffer (tramp-get-connection-property v "process-buffer" nil)))
+ (kill-buffer (tramp-get-connection-property v "process-buffer")))
(when process-file-side-effects
- (tramp-flush-directory-properties v ""))
+ (tramp-flush-directory-properties v "/"))
;; Return exit status.
(if (equal ret -1)
@@ -1395,7 +1391,7 @@ component is used as the target of the symlink."
(with-parsed-tramp-file-name
(if (tramp-tramp-file-p filename) filename newname) nil
(unless (file-exists-p filename)
- (tramp-compat-file-missing v filename))
+ (tramp-error v 'file-missing filename))
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
@@ -1423,9 +1419,9 @@ component is used as the target of the symlink."
v2 'file-error
"Target `%s' must contain a share name" newname))
(unless (tramp-smb-send-command
- v2 (format "rename \"%s\" \"%s\""
- (tramp-smb-get-localname v1)
- (tramp-smb-get-localname v2)))
+ v2 (format "rename %s %s"
+ (tramp-smb-shell-quote-localname v1)
+ (tramp-smb-shell-quote-localname v2)))
(tramp-error v2 'file-error "Cannot rename `%s'" filename))))
;; We must rename via copy.
@@ -1440,9 +1436,9 @@ component is used as the target of the symlink."
(unless (process-live-p proc)
;; Accept pending output.
(while (tramp-accept-process-output proc))
- (with-current-buffer (tramp-get-connection-buffer vec)
- (tramp-message vec 10 "\n%s" (buffer-string))
- (throw 'tramp-action 'ok))))
+ (tramp-message
+ vec 10 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec)))
+ (throw 'tramp-action 'ok)))
(defun tramp-smb-handle-set-file-acl (filename acl-string)
"Like `set-file-acl' for Tramp files."
@@ -1450,7 +1446,7 @@ component is used as the target of the symlink."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-property v localname "file-acl")
- (when (and (stringp acl-string) (executable-find tramp-smb-acl-program))
+ (when (and (stringp acl-string) (tramp-smb-remote-acl-p v))
(let* ((share (tramp-smb-get-share v))
(localname (tramp-compat-string-replace
"\\" "/" (tramp-smb-get-localname v)))
@@ -1478,52 +1474,53 @@ component is used as the target of the symlink."
"||" "echo" "tramp_exit_status" "1")))
(unwind-protect
- (with-temp-buffer
- ;; Set the transfer process properties.
- (tramp-set-connection-property
- v "process-name" (buffer-name (current-buffer)))
- (tramp-set-connection-property
- v "process-buffer" (current-buffer))
-
- ;; Use an asynchronous process. By this, password can
- ;; be handled.
- (let ((p (apply
- #'start-process
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- tramp-smb-acl-program args)))
-
- (tramp-message v 6 "%s" (string-join (process-command p) " "))
- (process-put p 'vector v)
- (process-put p 'adjust-window-size-function #'ignore)
- (set-process-query-on-exit-flag p nil)
- (tramp-process-actions p v nil tramp-smb-actions-set-acl)
- ;; This is meant for traces, and returning from the
- ;; function. No error is propagated outside, due to
- ;; the `ignore-errors' closure.
- (unless (tramp-search-regexp "tramp_exit_status [[:digit:]]+")
- (tramp-error
- v 'file-error
- "Couldn't find exit status of `%s'" tramp-smb-acl-program))
- (skip-chars-forward "^ ")
- (when (zerop (read (current-buffer)))
- ;; Success.
- (tramp-set-file-property v localname "file-acl" acl-string)
- t)))
-
- ;; Reset the transfer process properties.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")))))))
+ (with-tramp-saved-connection-properties
+ v '("process-name" "process-buffer")
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ ;; Use an asynchronous process. By this, password
+ ;; can be handled.
+ (let ((p (apply
+ #'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-acl-program args)))
+
+ (tramp-message
+ v 6 "%s" (string-join (process-command p) " "))
+ (process-put p 'vector v)
+ (process-put p 'adjust-window-size-function #'ignore)
+ (set-process-query-on-exit-flag p nil)
+ (tramp-process-actions p v nil tramp-smb-actions-set-acl)
+ ;; This is meant for traces, and returning from
+ ;; the function. No error is propagated outside,
+ ;; due to the `ignore-errors' closure.
+ (unless
+ (tramp-search-regexp (rx "tramp_exit_status " (+
digit)))
+ (tramp-error
+ v 'file-error
+ "Couldn't find exit status of `%s'"
+ tramp-smb-acl-program))
+ (skip-chars-forward "^ ")
+ (when (zerop (read (current-buffer)))
+ ;; Success.
+ (tramp-set-file-property v localname "file-acl"
acl-string)
+ t))))))))))
(defun tramp-smb-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- ;; smbclient chmod does not support nofollow.
- (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ ;; smbclient chmod does not support nofollow.
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(when (tramp-smb-get-cifs-capabilities v)
- (tramp-flush-file-properties v localname)
(unless (tramp-smb-send-command
- v (format "chmod \"%s\" %o" (tramp-smb-get-localname v) mode))
+ v
+ (format "chmod %s %o" (tramp-smb-shell-quote-localname v)
mode))
(tramp-error
v 'file-error "Error while changing file's mode %s" filename))))))
@@ -1541,41 +1538,50 @@ component is used as the target of the symlink."
(command (string-join (cons program args) " "))
(bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
(name1 name)
- (i 0))
+ (i 0)
+ p)
(unwind-protect
- (save-excursion
- (save-restriction
- (while (get-process name1)
- ;; NAME must be unique as process name.
- (setq i (1+ i)
- name1 (format "%s<%d>" name i)))
- ;; Set the new process properties.
- (tramp-set-connection-property v "process-name" name1)
- (tramp-set-connection-property v "process-buffer" buffer)
- ;; Activate narrowing in order to save BUFFER contents.
- (with-current-buffer (tramp-get-connection-buffer v)
- (let ((buffer-undo-list t))
- (narrow-to-region (point-max) (point-max))
- (tramp-smb-call-winexe v)
- (when (tramp-smb-get-share v)
- (tramp-smb-send-command
- v (format
- "cd \"//%s%s\""
- host (file-name-directory localname))))
- (tramp-message v 6 "(%s); exit" command)
- (tramp-send-string v command)))
- ;; Return value.
- (tramp-get-connection-process v)))
+ (with-tramp-saved-connection-properties
+ v '("process-name" "process-buffer")
+ (save-excursion
+ (save-restriction
+ (while (get-process name1)
+ ;; NAME must be unique as process name.
+ (setq i (1+ i)
+ name1 (format "%s<%d>" name i)))
+ ;; Set the new process properties.
+ (tramp-set-connection-property v "process-name" name1)
+ (tramp-set-connection-property v "process-buffer" buffer)
+ ;; Activate narrowing in order to save BUFFER contents.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (let ((buffer-undo-list t))
+ (narrow-to-region (point-max) (point-max))
+ (tramp-smb-call-winexe v)
+ (when (tramp-smb-get-share v)
+ (tramp-smb-send-command
+ v (format
+ "cd //%s%s"
+ host
+ (tramp-smb-shell-quote-argument
+ (file-name-directory localname)))))
+ (tramp-message v 6 "(%s); exit" command)
+ (tramp-send-string v command)))
+ (setq p (tramp-get-connection-process v))
+ (when program
+ (process-put p 'remote-command (cons program args))
+ (tramp-set-connection-property
+ p "remote-command" (cons program args)))
+ ;; Return value.
+ p)))
;; Save exit.
+ ;; FIXME: Does `tramp-get-connection-buffer' return the proper value?
(with-current-buffer (tramp-get-connection-buffer v)
(if (tramp-compat-string-search tramp-temp-buffer-name (buffer-name))
(progn
(set-process-buffer (tramp-get-connection-process v) nil)
(kill-buffer (current-buffer)))
- (set-buffer-modified-p bmp)))
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")))))
+ (set-buffer-modified-p bmp)))))))
(defun tramp-smb-handle-substitute-in-file-name (filename)
"Like `substitute-in-file-name' for Tramp files.
@@ -1586,7 +1592,8 @@ errors for shares like \"C$/\", which are common in
Microsoft Windows."
filename
(with-parsed-tramp-file-name filename nil
;; Ignore in LOCALNAME everything before "//".
- (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)"
localname))
+ (when (and (stringp localname)
+ (string-match (rx (+? nonl) "/" (group (| "/" "~")))
localname))
(setq filename
(concat (file-remote-p filename)
(replace-match "\\1" nil nil localname)))))
@@ -1594,31 +1601,20 @@ errors for shares like \"C$/\", which are common in
Microsoft Windows."
(tramp-run-real-handler #'substitute-in-file-name (list filename))
(error filename))))
+(defun tramp-smb-handle-get-home-directory (vec &optional user)
+ "The remote home directory for connection VEC as local file name.
+If USER is a string, return its home directory instead of the
+user identified by VEC. If there is no user specified in either
+VEC or USER, or if there is no home directory, return nil."
+ (let ((user (or user (tramp-file-name-user vec))))
+ (unless (zerop (length user))
+ (concat "/" user))))
+
(defun tramp-smb-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename)
- lockname (file-truename (or lockname filename)))
- (with-parsed-tramp-file-name filename nil
- (when (and mustbenew (file-exists-p filename)
- (or (eq mustbenew 'excl)
- (not
- (y-or-n-p
- (format "File %s exists; overwrite anyway?" filename)))))
- (tramp-error v 'file-already-exists filename))
-
- (let ((file-locked (eq (file-locked-p lockname) t))
- (curbuf (current-buffer))
- (tmpfile (tramp-compat-make-temp-file filename)))
-
- ;; Lock file.
- (when (and (not (auto-save-file-name-p (file-name-nondirectory
filename)))
- (file-remote-p lockname)
- (not file-locked))
- (setq file-locked t)
- ;; `lock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'lock-file lockname))
-
+ (tramp-skeleton-write-region start end filename append visit lockname
mustbenew
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
(when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok))
;; We say `no-message' here because we don't want the visited file
@@ -1631,37 +1627,11 @@ errors for shares like \"C$/\", which are common in
Microsoft Windows."
v 3 (format "Moving tmp file %s to %s" tmpfile filename)
(unwind-protect
(unless (tramp-smb-send-command
- v (format "put \"%s\" \"%s\""
- tmpfile (tramp-smb-get-localname v)))
+ v (format "put %s %s"
+ (tramp-smb-shell-quote-argument tmpfile)
+ (tramp-smb-shell-quote-localname v)))
(tramp-error v 'file-error "Cannot write `%s'" filename))
- (delete-file tmpfile)))
-
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v localname)
-
- (unless (equal curbuf (current-buffer))
- (tramp-error
- v 'file-error
- "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))
-
- ;; Set file modification time.
- (when (or (eq visit t) (stringp visit))
- (set-visited-file-modtime
- (or (tramp-compat-file-attribute-modification-time
- (file-attributes filename))
- (current-time))))
-
- ;; Unlock file.
- (when file-locked
- ;; `unlock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'unlock-file lockname))
-
- ;; The end.
- (when (and (null noninteractive)
- (or (eq visit t) (string-or-null-p visit)))
- (tramp-message v 0 "Wrote %s" filename))
- (run-hooks 'tramp-handle-write-region-hook))))
+ (delete-file tmpfile))))))
;; Internal file name functions.
@@ -1669,7 +1639,8 @@ errors for shares like \"C$/\", which are common in
Microsoft Windows."
"Return the share name of LOCALNAME."
(save-match-data
(let ((localname (tramp-file-name-unquote-localname vec)))
- (when (string-match "^/?\\([^/]+\\)/" localname)
+ (when (string-match
+ (tramp-compat-rx bol (? "/") (group (+ (not "/"))) "/") localname)
(match-string 1 localname)))))
(defun tramp-smb-get-localname (vec)
@@ -1679,7 +1650,9 @@ If VEC has no cifs capabilities, exchange \"/\" by
\"\\\\\"."
(let ((localname (tramp-file-name-unquote-localname vec)))
(setq
localname
- (if (string-match "^/?[^/]+\\(/.*\\)" localname)
+ (if (string-match
+ (tramp-compat-rx bol (? "/") (+ (not "/")) (group "/" (* nonl)))
+ localname)
;; There is a share, separated by "/".
(if (not (tramp-smb-get-cifs-capabilities vec))
(mapconcat
@@ -1687,16 +1660,17 @@ If VEC has no cifs capabilities, exchange \"/\" by
\"\\\\\"."
(match-string 1 localname) "")
(match-string 1 localname))
;; There is just a share.
- (if (string-match "^/?\\([^/]+\\)$" localname)
+ (if (string-match
+ (tramp-compat-rx bol (? "/") (group (+ (not "/"))) eol) localname)
(match-string 1 localname)
"")))
;; Sometimes we have discarded `substitute-in-file-name'.
- (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" localname)
+ (when (string-match (rx (group "$$") (| "/" eol)) localname)
(setq localname (replace-match "$" nil nil localname 1)))
;; A trailing space is not supported.
- (when (string-match-p " $" localname)
+ (when (string-match-p (rx blank eol) localname)
(tramp-error
vec 'file-error
"Invalid file name %s" (tramp-make-tramp-file-name vec localname)))
@@ -1717,7 +1691,7 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME
YEAR)."
(setq localname (or localname "/"))
(with-tramp-file-property v localname "file-entries"
(let* ((share (tramp-smb-get-share v))
- (cache (tramp-get-connection-property v "share-cache" nil))
+ (cache (tramp-get-connection-property v "share-cache"))
res entry)
(if (and (not share) cache)
@@ -1727,7 +1701,7 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME
YEAR)."
;; Read entries.
(if share
(tramp-smb-send-command
- v (format "dir \"%s*\"" (tramp-smb-get-localname v)))
+ v (format "dir %s*" (tramp-smb-shell-quote-localname v)))
;; `tramp-smb-maybe-open-connection' lists also the share names.
(tramp-smb-maybe-open-connection v))
@@ -1797,7 +1771,7 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME
YEAR)."
;;
;; Problems:
;; * Modern regexp constructs, like spy groups and counted repetitions, aren't
-;; available in older Emacsen.
+;; available in older versions of Emacs.
;; * The length of constructs (file name, size) might exceed the default.
;; * File names might contain spaces.
;; * Permissions might be empty.
@@ -1809,13 +1783,14 @@ If SHARE is result, entries are of type dir.
Otherwise, shares
are listed. Result is the list (LOCALNAME MODE SIZE MTIME)."
;; We are called from `tramp-smb-get-file-entries', which sets the
;; current buffer.
- (let ((line (buffer-substring (point) (point-at-eol)))
+ (let ((line (buffer-substring (point) (line-end-position)))
localname mode size month day hour min sec year mtime)
(if (not share)
;; Read share entries.
- (when (string-match "^Disk|\\([^|]+\\)|" line)
+ (when (string-match
+ (tramp-compat-rx bol "Disk|" (group (+ (not "|"))) "|") line)
(setq localname (match-string 1 line)
mode "dr-xr-xr-x"
size 0))
@@ -1824,14 +1799,17 @@ are listed. Result is the list (LOCALNAME MODE SIZE
MTIME)."
(cl-block nil
;; year.
- (if (string-match "\\([[:digit:]]+\\)$" line)
+ (if (string-match (rx (group (+ digit)) eol) line)
(setq year (string-to-number (match-string 1 line))
line (substring line 0 -5))
(cl-return))
;; time.
(if (string-match
- "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)$" line)
+ (rx (group (+ digit)) ":"
+ (group (+ digit)) ":"
+ (group (+ digit)) eol)
+ line)
(setq hour (string-to-number (match-string 1 line))
min (string-to-number (match-string 2 line))
sec (string-to-number (match-string 3 line))
@@ -1839,28 +1817,28 @@ are listed. Result is the list (LOCALNAME MODE SIZE
MTIME)."
(cl-return))
;; day.
- (if (string-match "\\([[:digit:]]+\\)$" line)
+ (if (string-match (rx (group (+ digit)) eol) line)
(setq day (string-to-number (match-string 1 line))
line (substring line 0 -3))
(cl-return))
;; month.
- (if (string-match "\\(\\w+\\)$" line)
+ (if (string-match (rx (group (+ wordchar)) eol) line)
(setq month (match-string 1 line)
line (substring line 0 -4))
(cl-return))
;; weekday.
- (if (string-match-p "\\(\\w+\\)$" line)
+ (if (string-match-p (rx (+ wordchar) eol) line)
(setq line (substring line 0 -5))
(cl-return))
;; size.
- (if (string-match "\\([[:digit:]]+\\)$" line)
+ (if (string-match (rx (group (+ digit)) eol) line)
(let ((length (- (max 10 (1+ (length (match-string 1 line)))))))
(setq size (string-to-number (match-string 1 line)))
(when (string-match
- "\\([ACDEHNORrsSTV]+\\)" (substring line length))
+ (rx (+ (any "ACDEHNORSTVrs"))) (substring line length))
(setq length (+ length (match-end 0))))
(setq line (substring line 0 length)))
(cl-return))
@@ -1869,7 +1847,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE
MTIME)."
;; NONINDEXED, NORMAL, OFFLINE, READONLY,
;; REPARSE_POINT, SPARSE, SYSTEM, TEMPORARY, VOLID.
- (if (string-match "\\([ACDEHNORrsSTV]+\\)?$" line)
+ (if (string-match (rx (? (group (+ (any "ACDEHNORSTVrs")))) eol) line)
(setq
mode (or (match-string 1 line) "")
mode (format
@@ -1884,7 +1862,11 @@ are listed. Result is the list (LOCALNAME MODE SIZE
MTIME)."
(cl-return))
;; localname.
- (if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-*$" line)
+ (if (string-match
+ (rx bol (+ blank)
+ (group (not blank) (? (* nonl) (not blank)))
+ (* blank) eol)
+ line)
(setq localname (match-string 1 line))
(cl-return))))
@@ -1923,7 +1905,8 @@ are listed. Result is the list (LOCALNAME MODE SIZE
MTIME)."
(member
"pathnames"
(split-string
- (buffer-substring (point) (point-at-eol)) nil 'omit)))))))))
+ (buffer-substring (point) (line-end-position))
+ nil 'omit)))))))))
(defun tramp-smb-get-stat-capability (vec)
"Check whether the SMB server supports the `stat' command."
@@ -1931,7 +1914,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE
MTIME)."
(if (and (tramp-smb-get-share vec)
(process-live-p (tramp-get-connection-process vec)))
(with-tramp-connection-property (tramp-get-process vec) "stat-capability"
- (tramp-smb-send-command vec "stat \"/\""))))
+ (tramp-smb-send-command vec "stat /"))))
;; Connection functions.
@@ -1973,7 +1956,7 @@ If ARGUMENT is non-nil, use it as argument for
(setq tramp-smb-version (shell-command-to-string command))
(tramp-message vec 6 command)
(tramp-message vec 6 "\n%s" tramp-smb-version)
- (if (string-match "[ \t\n\r]+\\'" tramp-smb-version)
+ (if (string-match (rx (+ (any " \t\n\r")) eos) tramp-smb-version)
(setq tramp-smb-version
(replace-match "" nil nil tramp-smb-version))))
@@ -1981,7 +1964,7 @@ If ARGUMENT is non-nil, use it as argument for
tramp-smb-version
(tramp-get-connection-property
vec "smbclient-version" tramp-smb-version))
- (tramp-flush-directory-properties vec "")
+ (tramp-flush-directory-properties vec "/")
(tramp-flush-connection-properties vec))
(tramp-set-connection-property
@@ -2046,7 +2029,7 @@ If ARGUMENT is non-nil, use it as argument for
(if (not (zerop (length user))) (concat user "@") "")
host (or share ""))
- (let* ((coding-system-for-read nil)
+ (let* (coding-system-for-read
(process-connection-type tramp-process-connection-type)
(p (let ((default-directory
tramp-compat-temporary-file-directory)
@@ -2077,24 +2060,6 @@ If ARGUMENT is non-nil, use it as argument for
tramp-smb-actions-with-share
tramp-smb-actions-without-share))
- ;; Check server version.
- ;; FIXME: With recent smbclient versions, this
- ;; information isn't printed anymore.
- ;; (unless argument
- ;; (with-current-buffer (tramp-get-connection-buffer vec)
- ;; (goto-char (point-min))
- ;; (search-forward-regexp tramp-smb-server-version nil t)
- ;; (let ((smbserver-version (match-string 0)))
- ;; (unless
- ;; (string-equal
- ;; smbserver-version
- ;; (tramp-get-connection-property
- ;; vec "smbserver-version" smbserver-version))
- ;; (tramp-flush-directory-properties vec "")
- ;; (tramp-flush-connection-properties vec))
- ;; (tramp-set-connection-property
- ;; vec "smbserver-version" smbserver-version))))
-
;; Set chunksize to 1. smbclient reads its input
;; character by character; if we send the string
;; at once, it is read painfully slow.
@@ -2191,6 +2156,10 @@ Removes smb prompt. Returns nil if an error message has
appeared."
(let ((system-type 'ms-dos))
(tramp-unquote-shell-quote-argument s)))
+(defun tramp-smb-shell-quote-localname (vec)
+ "Call `tramp-smb-shell-quote-argument' on localname of VEC."
+ (tramp-smb-shell-quote-argument (tramp-smb-get-localname vec)))
+
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-smb 'force)))
diff --git a/tramp-sshfs.el b/tramp-sshfs.el
index b229f58924..44c55041ff 100644
--- a/tramp-sshfs.el
+++ b/tramp-sshfs.el
@@ -46,6 +46,9 @@
:version "28.1"
:type 'string)
+;;;###tramp-autoload
+(defvar tramp-default-remote-shell) ;; Silence byte compiler.
+
;;;###tramp-autoload
(tramp--with-startup
(add-to-list 'tramp-methods
@@ -74,7 +77,8 @@
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-sshfs-file-name-handler-alist
- '((access-file . tramp-handle-access-file)
+ '(;; `abbreviate-file-name' performed by default handler.
+ (access-file . tramp-handle-access-file)
(add-name-to-file . tramp-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
(copy-directory . tramp-handle-copy-directory)
@@ -125,6 +129,7 @@
;; `get-file-buffer' performed by default handler.
(insert-directory . tramp-handle-insert-directory)
(insert-file-contents . tramp-sshfs-handle-insert-file-contents)
+ (list-system-processes . tramp-handle-list-system-processes)
(load . tramp-handle-load)
(lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
@@ -134,6 +139,8 @@
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . tramp-handle-make-process)
(make-symbolic-link . tramp-handle-make-symbolic-link)
+ (memory-info . tramp-handle-memory-info)
+ (process-attributes . tramp-handle-process-attributes)
(process-file . tramp-sshfs-handle-process-file)
(rename-file . tramp-sshfs-handle-rename-file)
(set-file-acl . ignore)
@@ -145,7 +152,9 @@
(start-file-process . tramp-handle-start-file-process)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-home-directory . ignore)
(tramp-get-remote-gid . ignore)
+ (tramp-get-remote-groups . ignore)
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
@@ -159,11 +168,10 @@ Operations not mentioned here will be handled by the
default Emacs primitives.")
;; It must be a `defsubst' in order to push the whole code into
;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
;;;###tramp-autoload
-(defsubst tramp-sshfs-file-name-p (filename)
- "Check if it's a FILENAME for sshfs."
- (and (tramp-tramp-file-p filename)
- (string= (tramp-file-name-method (tramp-dissect-file-name filename))
- tramp-sshfs-method)))
+(defsubst tramp-sshfs-file-name-p (vec-or-filename)
+ "Check if it's a VEC-OR-FILENAME for sshfs."
+ (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
+ (string= (tramp-file-name-method vec) tramp-sshfs-method)))
;;;###tramp-autoload
(defun tramp-sshfs-file-name-handler (operation &rest args)
@@ -207,12 +215,13 @@ arguments to pass to the OPERATION."
(with-parsed-tramp-file-name default-directory nil
(with-tramp-connection-property (tramp-get-process v) "remote-path"
(with-temp-buffer
- (process-file "getconf" nil t nil "PATH")
+ (let (process-file-side-effects)
+ (process-file "getconf" nil t nil "PATH"))
(split-string
(progn
;; Read the expression.
(goto-char (point-min))
- (buffer-substring (point) (point-at-eol)))
+ (buffer-substring (point) (line-end-position)))
":" 'omit))))
;; The equivalent to `exec-directory'.
`(,(tramp-file-local-name (expand-file-name default-directory)))))
@@ -263,7 +272,7 @@ arguments to pass to the OPERATION."
(setq input (tramp-unquote-file-local-name infile))
;; INFILE must be copied to remote host.
(setq input (tramp-make-tramp-temp-file v)
- tmpinput (tramp-make-tramp-file-name v input 'nohop))
+ tmpinput (tramp-make-tramp-file-name v input))
(copy-file infile tmpinput t)))
(when input (setq command (format "%s <%s" command input)))
@@ -330,7 +339,7 @@ arguments to pass to the OPERATION."
;; them.
(when tmpinput (delete-file tmpinput))
(when process-file-side-effects
- (tramp-flush-directory-properties v ""))))))
+ (tramp-flush-directory-properties v "/"))))))
(defun tramp-sshfs-handle-rename-file
(filename newname &optional ok-if-already-exists)
@@ -352,66 +361,25 @@ arguments to pass to the OPERATION."
(defun tramp-sshfs-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (unless (and (eq flag 'nofollow) (file-symlink-p filename))
- (tramp-flush-file-properties v localname)
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(tramp-compat-set-file-modes
(tramp-fuse-local-file-name filename) mode flag))))
(defun tramp-sshfs-handle-set-file-times (filename &optional timestamp flag)
"Like `set-file-times' for Tramp files."
- (or (file-exists-p filename) (write-region "" nil filename nil 0))
- (with-parsed-tramp-file-name filename nil
- (unless (and (eq flag 'nofollow) (file-symlink-p filename))
- (tramp-flush-file-properties v localname)
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(tramp-compat-set-file-times
(tramp-fuse-local-file-name filename) timestamp flag))))
(defun tramp-sshfs-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename)
- lockname (file-truename (or lockname filename)))
- (with-parsed-tramp-file-name filename nil
- (when (and mustbenew (file-exists-p filename)
- (or (eq mustbenew 'excl)
- (not
- (y-or-n-p
- (format "File %s exists; overwrite anyway?" filename)))))
- (tramp-error v 'file-already-exists filename))
-
- (let ((file-locked (eq (file-locked-p lockname) t)))
-
- ;; Lock file.
- (when (and (not (auto-save-file-name-p (file-name-nondirectory
filename)))
- (file-remote-p lockname)
- (not file-locked))
- (setq file-locked t)
- ;; `lock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'lock-file lockname))
-
- (let (create-lockfiles)
- (write-region
- start end (tramp-fuse-local-file-name filename) append 'nomessage)
- (tramp-flush-file-properties v localname))
-
- ;; Set file modification time.
- (when (or (eq visit t) (stringp visit))
- (set-visited-file-modtime
- (or (tramp-compat-file-attribute-modification-time
- (file-attributes filename))
- (current-time))))
-
- ;; Unlock file.
- (when file-locked
- ;; `unlock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'unlock-file lockname))
-
- ;; The end.
- (when (and (null noninteractive)
- (or (eq visit t) (string-or-null-p visit)))
- (tramp-message v 0 "Wrote %s" filename))
- (run-hooks 'tramp-handle-write-region-hook))))
+ (tramp-skeleton-write-region start end filename append visit lockname
mustbenew
+ (let (create-lockfiles)
+ (write-region
+ start end (tramp-fuse-local-file-name filename) append 'nomessage))))
;; File name conversions.
@@ -484,7 +452,7 @@ connection if a previous connection has died for some
reason."
(funcall orig-fun)))
(add-function
- :around (symbol-function #'shell-mode) #'tramp-sshfs-tolerate-tilde)
+ :around (symbol-function #'shell-mode) #'tramp-sshfs-tolerate-tilde)
(add-hook 'tramp-sshfs-unload-hook
(lambda ()
(remove-function
diff --git a/tramp-sudoedit.el b/tramp-sudoedit.el
index 06100fbde0..fcc27dd834 100644
--- a/tramp-sudoedit.el
+++ b/tramp-sudoedit.el
@@ -45,9 +45,12 @@
(add-to-list 'tramp-methods
`(,tramp-sudoedit-method
(tramp-sudo-login (("sudo") ("-u" "%u") ("-S") ("-H")
- ("-p" "Password:") ("--")))))
+ ("-p" "Password:") ("--")))
+ (tramp-password-previous-hop t)))
- (add-to-list 'tramp-default-user-alist '("\\`sudoedit\\'" nil "root"))
+ (add-to-list 'tramp-default-user-alist
+ `(,(tramp-compat-rx bos (literal tramp-sudoedit-method) eos)
+ nil ,tramp-root-id-string))
(tramp-set-completion-function
tramp-sudoedit-method tramp-completion-function-alist-su))
@@ -63,7 +66,8 @@ See `tramp-actions-before-shell' for more info.")
;;;###tramp-autoload
(defconst tramp-sudoedit-file-name-handler-alist
- '((access-file . tramp-handle-access-file)
+ '((abbreviate-file-name . tramp-handle-abbreviate-file-name)
+ (access-file . tramp-handle-access-file)
(add-name-to-file . tramp-sudoedit-handle-add-name-to-file)
(byte-compiler-base-file-name . ignore)
(copy-directory . tramp-handle-copy-directory)
@@ -115,6 +119,7 @@ See `tramp-actions-before-shell' for more info.")
;; `get-file-buffer' performed by default handler.
(insert-directory . tramp-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
+ (list-system-processes . ignore)
(load . tramp-handle-load)
(lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
@@ -124,6 +129,8 @@ See `tramp-actions-before-shell' for more info.")
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
(make-symbolic-link . tramp-sudoedit-handle-make-symbolic-link)
+ (memory-info . ignore)
+ (process-attributes . ignore)
(process-file . ignore)
(rename-file . tramp-sudoedit-handle-rename-file)
(set-file-acl . tramp-sudoedit-handle-set-file-acl)
@@ -135,24 +142,25 @@ See `tramp-actions-before-shell' for more info.")
(start-file-process . ignore)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-home-directory . tramp-sudoedit-handle-get-home-directory)
(tramp-get-remote-gid . tramp-sudoedit-handle-get-remote-gid)
+ (tramp-get-remote-groups . tramp-sudoedit-handle-get-remote-groups)
(tramp-get-remote-uid . tramp-sudoedit-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-sudoedit-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore)
(unlock-file . tramp-handle-unlock-file)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
- (write-region . tramp-sudoedit-handle-write-region))
+ (write-region . tramp-handle-write-region))
"Alist of handler functions for Tramp SUDOEDIT method.")
;; It must be a `defsubst' in order to push the whole code into
;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
;;;###tramp-autoload
-(defsubst tramp-sudoedit-file-name-p (filename)
- "Check if it's a FILENAME for SUDOEDIT."
- (and (tramp-tramp-file-p filename)
- (string= (tramp-file-name-method (tramp-dissect-file-name filename))
- tramp-sudoedit-method)))
+(defsubst tramp-sudoedit-file-name-p (vec-or-filename)
+ "Check if it's a VEC-OR-FILENAME for SUDOEDIT."
+ (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
+ (string= (tramp-file-name-method vec) tramp-sudoedit-method)))
;;;###tramp-autoload
(defun tramp-sudoedit-file-name-handler (operation &rest args)
@@ -168,6 +176,12 @@ arguments to pass to the OPERATION."
(tramp-register-foreign-file-name-handler
#'tramp-sudoedit-file-name-p #'tramp-sudoedit-file-name-handler))
+;; Needed for `tramp-read-passwd'.
+(defconst tramp-sudoedit-null-hop
+ (make-tramp-file-name
+ :method tramp-sudoedit-method :user (user-login-name) :host
tramp-system-name)
+"Connection hop which identifies the virtual hop before the first one.")
+
;; File name primitives.
@@ -181,8 +195,8 @@ arguments to pass to the OPERATION."
v 'file-error
"add-name-to-file: %s"
"only implemented for same method, same user, same host")))
- (with-parsed-tramp-file-name filename v1
- (with-parsed-tramp-file-name newname v2
+ (with-parsed-tramp-file-name (expand-file-name filename) v1
+ (with-parsed-tramp-file-name (expand-file-name newname) v2
;; Do the 'confirm if exists' thing.
(when (file-exists-p newname)
;; What to do?
@@ -222,6 +236,7 @@ This function is invoked by
`tramp-sudoedit-handle-copy-file' and
`tramp-sudoedit-handle-rename-file'. It is an error if OP is
neither of `copy' and `rename'. FILENAME and NEWNAME must be
absolute file names."
+ ;; FILENAME and NEWNAME are already expanded.
(unless (memq op '(copy rename))
(error "Unknown operation `%s', must be `copy' or `rename'" op))
@@ -231,9 +246,11 @@ absolute file names."
(copy-directory filename newname keep-date t)
(when (eq op 'rename) (delete-directory filename 'recursive)))
+ ;; FIXME: This should be optimized. Computing `file-attributes'
+ ;; checks already, whether the file exists.
(let ((t1 (tramp-sudoedit-file-name-p filename))
(t2 (tramp-sudoedit-file-name-p newname))
- (file-times (tramp-compat-file-attribute-modification-time
+ (file-times (file-attribute-modification-time
(file-attributes filename)))
(file-modes (tramp-default-file-modes filename))
(attributes (and preserve-extended-attributes
@@ -246,62 +263,61 @@ absolute file names."
(msg-operation (if (eq op 'copy) "Copying" "Renaming")))
(with-parsed-tramp-file-name (if t1 filename newname) nil
- (unless (file-exists-p filename)
- (tramp-compat-file-missing v filename))
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-error "File is a directory %s" newname))
-
- (if (or (and (file-remote-p filename) (not t1))
- (and (file-remote-p newname) (not t2)))
- ;; We cannot copy or rename directly.
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (if (eq op 'copy)
- (copy-file filename tmpfile t)
- (rename-file filename tmpfile t))
- (rename-file tmpfile newname ok-if-already-exists))
-
- ;; Direct action.
- (with-tramp-progress-reporter
- v 0 (format "%s %s to %s" msg-operation filename newname)
- (unless (tramp-sudoedit-send-command
- v sudoedit-operation
- (tramp-unquote-file-local-name filename)
- (tramp-unquote-file-local-name newname))
- (tramp-error
- v 'file-error
- "Error %s `%s' `%s'" msg-operation filename newname))))
-
- ;; When `newname' is local, we must change the ownership to
- ;; the local user.
- (unless (file-remote-p newname)
- (tramp-set-file-uid-gid
- (concat (file-remote-p filename) newname)
- (tramp-get-local-uid 'integer)
- (tramp-get-local-gid 'integer)))
-
- ;; Set the time and mode. Mask possible errors.
- (when keep-date
- (ignore-errors
- (tramp-compat-set-file-times
- newname file-times (unless ok-if-already-exists 'nofollow))
- (set-file-modes newname file-modes)))
-
- ;; Handle `preserve-extended-attributes'. We ignore possible
- ;; errors, because ACL strings could be incompatible.
- (when attributes
- (ignore-errors
- (set-file-extended-attributes newname attributes)))
-
- (when (and t1 (eq op 'rename))
- (with-parsed-tramp-file-name filename v1
- (tramp-flush-file-properties v1 v1-localname)))
-
- (when t2
- (with-parsed-tramp-file-name newname v2
- (tramp-flush-file-properties v2 v2-localname)))))))
+ (tramp-barf-if-file-missing v filename
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-error "File is a directory %s" newname))
+
+ (if (or (and (file-remote-p filename) (not t1))
+ (and (file-remote-p newname) (not t2)))
+ ;; We cannot copy or rename directly.
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
+ (if (eq op 'copy)
+ (copy-file filename tmpfile t)
+ (rename-file filename tmpfile t))
+ (rename-file tmpfile newname ok-if-already-exists))
+
+ ;; Direct action.
+ (with-tramp-progress-reporter
+ v 0 (format "%s %s to %s" msg-operation filename newname)
+ (unless (tramp-sudoedit-send-command
+ v sudoedit-operation
+ (tramp-unquote-file-local-name filename)
+ (tramp-unquote-file-local-name newname))
+ (tramp-error
+ v 'file-error
+ "Error %s `%s' `%s'" msg-operation filename newname))))
+
+ ;; When `newname' is local, we must change the ownership to
+ ;; the local user.
+ (unless (file-remote-p newname)
+ (tramp-set-file-uid-gid
+ (concat (file-remote-p filename) newname)
+ (tramp-get-local-uid 'integer)
+ (tramp-get-local-gid 'integer)))
+
+ ;; Set the time and mode. Mask possible errors.
+ (when keep-date
+ (ignore-errors
+ (tramp-compat-set-file-times
+ newname file-times (unless ok-if-already-exists 'nofollow))
+ (set-file-modes newname file-modes)))
+
+ ;; Handle `preserve-extended-attributes'. We ignore possible
+ ;; errors, because ACL strings could be incompatible.
+ (when attributes
+ (ignore-errors
+ (set-file-extended-attributes newname attributes)))
+
+ (when (and t1 (eq op 'rename))
+ (with-parsed-tramp-file-name filename v1
+ (tramp-flush-file-properties v1 v1-localname)))
+
+ (when t2
+ (with-parsed-tramp-file-name newname v2
+ (tramp-flush-file-properties v2 v2-localname))))))))
(defun tramp-sudoedit-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
@@ -331,7 +347,7 @@ absolute file names."
(defun tramp-sudoedit-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(tramp-flush-file-properties v localname)
(if (and delete-by-moving-to-trash trash)
(move-file-to-trash filename)
@@ -354,25 +370,36 @@ the result will be a local, non-Tramp, file name."
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
(setq name (tramp-compat-file-name-concat dir name)))
- (with-parsed-tramp-file-name name nil
- ;; Tilde expansion if necessary. We cannot accept "~/", because
- ;; under sudo "~/" is expanded to the local user home directory
- ;; but to the root home directory.
- (when (zerop (length localname))
- (setq localname "~"))
- (unless (file-name-absolute-p localname)
- (setq localname (format "~%s/%s" user localname)))
- (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
- (let ((uname (match-string 1 localname))
- (fname (match-string 2 localname)))
- (when (string-equal uname "~")
- (setq uname (concat uname user)))
- (setq localname (concat uname fname))))
- ;; Do not keep "/..".
- (when (string-match-p "^/\\.\\.?$" localname)
+ ;; If NAME is not a Tramp file, run the real handler.
+ (if (not (tramp-tramp-file-p name))
+ (tramp-run-real-handler #'expand-file-name (list name))
+ (with-parsed-tramp-file-name name nil
+ ;; Tilde expansion if necessary. We cannot accept "~/", because
+ ;; under sudo "~/" is expanded to the local user home directory
+ ;; but to the root home directory.
+ (when (zerop (length localname))
+ (setq localname "~"))
+ (unless (file-name-absolute-p localname)
+ (setq localname (format "~%s/%s" user localname)))
+ (when (string-match
+ (tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl))
eos)
+ localname)
+ (let ((uname (match-string 1 localname))
+ (fname (match-string 2 localname))
+ hname)
+ (when (zerop (length uname))
+ (setq uname user))
+ (when (setq hname (tramp-get-home-directory v uname))
+ (setq localname (concat hname fname)))))
+ ;; Do not keep "/..".
+ (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname)
(setq localname "/"))
- ;; Do normal `expand-file-name' (this does "~user/", "/./" and "/../").
- (tramp-make-tramp-file-name v (expand-file-name localname))))
+ ;; Do normal `expand-file-name' (this does "~user/", "/./" and "/../").
+ (tramp-make-tramp-file-name
+ v (if (string-prefix-p "~" localname)
+ localname
+ (tramp-run-real-handler
+ #'expand-file-name (list localname)))))))
(defun tramp-sudoedit-remote-acl-p (vec)
"Check, whether ACL is enabled on the remote host."
@@ -381,7 +408,7 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sudoedit-handle-file-acl (filename)
"Like `file-acl' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-acl"
(let ((result (and (tramp-sudoedit-remote-acl-p v)
(tramp-sudoedit-send-command-string
@@ -391,41 +418,42 @@ the result will be a local, non-Tramp, file name."
;; provided by `tramp-sudoedit-send-command-string'. Add it.
(and (stringp result) (concat result "\n"))))))
+(defconst tramp-sudoedit-file-attributes
+ (format
+ ;; Apostrophes in the stat output are masked as
+ ;; `tramp-stat-marker', in order to make a proper shell escape of
+ ;; them in file names. They are replaced in
+ ;; `tramp-sudoedit-send-command-and-read'.
+ (concat "((%s%%N%s) %%h (%s%%U%s . %%u) (%s%%G%s . %%g)"
+ " %%X %%Y %%Z %%s %s%%A%s t %%i -1)")
+ tramp-stat-marker tramp-stat-marker ; %%N
+ tramp-stat-marker tramp-stat-marker ; %%U
+ tramp-stat-marker tramp-stat-marker ; %%G
+ tramp-stat-marker tramp-stat-marker) ; %%A
+ "stat format string to produce output suitable for use with
+`file-attributes' on the remote file system.")
+
(defun tramp-sudoedit-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
- (unless id-format (setq id-format 'integer))
+ ;; The result is cached in `tramp-convert-file-attributes'.
(with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-file-property
- v localname (format "file-attributes-%s" id-format)
- (tramp-message v 5 "file attributes: %s" localname)
- (ignore-errors
- (tramp-convert-file-attributes
- v
- (tramp-sudoedit-send-command-and-read
- v "env" "QUOTING_STYLE=locale" "stat" "-c"
- (format
- ;; Apostrophes in the stat output are masked as
- ;; `tramp-stat-marker', in order to make a proper shell
- ;; escape of them in file names.
- "((%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)"
- tramp-stat-marker tramp-stat-marker
- (if (eq id-format 'integer)
- "%u"
- (eval-when-compile
- (concat tramp-stat-marker "%U" tramp-stat-marker)))
- (if (eq id-format 'integer)
- "%g"
- (eval-when-compile
- (concat tramp-stat-marker "%G" tramp-stat-marker)))
- tramp-stat-marker tramp-stat-marker)
- (tramp-compat-file-name-unquote localname)))))))
+ (tramp-convert-file-attributes v localname id-format
+ (tramp-sudoedit-send-command-and-read
+ v "env" "QUOTING_STYLE=locale" "stat" "-c"
+ tramp-sudoedit-file-attributes
+ (tramp-compat-file-name-unquote localname)))))
(defun tramp-sudoedit-handle-file-executable-p (filename)
"Like `file-executable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-executable-p"
- (tramp-sudoedit-send-command
- v "test" "-x" (tramp-compat-file-name-unquote localname)))))
+ ;; Examine `file-attributes' cache to see if request can be
+ ;; satisfied without remote operation.
+ (if (tramp-file-property-p v localname "file-attributes")
+ (or (tramp-check-cached-permissions v ?x)
+ (tramp-check-cached-permissions v ?s))
+ (tramp-sudoedit-send-command
+ v "test" "-x" (tramp-compat-file-name-unquote localname))))))
(defun tramp-sudoedit-handle-file-exists-p (filename)
"Like `file-exists-p' for Tramp files."
@@ -433,10 +461,12 @@ the result will be a local, non-Tramp, file name."
;; We don't want to run it when `non-essential' is t, or there is
;; no connection process yet.
(when (tramp-connectable-p filename)
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-exists-p"
- (tramp-sudoedit-send-command
- v "test" "-e" (tramp-compat-file-name-unquote localname))))))
+ (if (tramp-file-property-p v localname "file-attributes")
+ (not (null (tramp-get-file-property v localname "file-attributes")))
+ (tramp-sudoedit-send-command
+ v "test" "-e" (tramp-compat-file-name-unquote localname)))))))
(defun tramp-sudoedit-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
@@ -453,27 +483,30 @@ the result will be a local, non-Tramp, file name."
(if (file-directory-p (expand-file-name f directory))
(file-name-as-directory f)
f))
- (with-current-buffer (tramp-get-connection-buffer v)
- (delq
- nil
- (mapcar
- (lambda (l) (and (not (string-match-p "^[[:space:]]*$" l)) l))
- (split-string (buffer-string) "\n" 'omit)))))))))
+ (delq
+ nil
+ (mapcar
+ (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l))
+ (split-string
+ (tramp-get-buffer-string (tramp-get-connection-buffer v))
+ "\n" 'omit))))))))
(defun tramp-sudoedit-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-readable-p"
- (or (tramp-handle-file-readable-p filename)
- (tramp-sudoedit-send-command
- v "test" "-r" (tramp-compat-file-name-unquote localname))))))
+ ;; Examine `file-attributes' cache to see if request can be
+ ;; satisfied without remote operation.
+ (if (tramp-file-property-p v localname "file-attributes")
+ (tramp-handle-file-readable-p filename)
+ (tramp-sudoedit-send-command
+ v "test" "-r" (tramp-compat-file-name-unquote localname))))))
(defun tramp-sudoedit-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- ;; It is unlikely that "chmod -h" works.
- (unless (and (eq flag 'nofollow) (file-symlink-p filename))
- (tramp-flush-file-properties v localname)
+ ;; It is unlikely that "chmod -h" works.
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(unless (tramp-sudoedit-send-command
v "chmod" (format "%o" mode)
(tramp-compat-file-name-unquote localname))
@@ -487,18 +520,21 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sudoedit-handle-file-selinux-context (filename)
"Like `file-selinux-context' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-selinux-context"
(let ((context '(nil nil nil nil))
- (regexp (concat "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\):"
- "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\)")))
+ (regexp (tramp-compat-rx
+ (group (+ (any "_" alnum))) ":"
+ (group (+ (any "_" alnum))) ":"
+ (group (+ (any "_" alnum))) ":"
+ (group (+ (any "_" alnum))))))
(when (and (tramp-sudoedit-remote-selinux-p v)
(tramp-sudoedit-send-command
v "ls" "-d" "-Z"
(tramp-compat-file-name-unquote localname)))
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
- (when (re-search-forward regexp (point-at-eol) t)
+ (when (re-search-forward regexp (line-end-position) t)
(setq context (list (match-string 1) (match-string 2)
(match-string 3) (match-string 4))))))
;; Return the context.
@@ -516,9 +552,9 @@ the result will be a local, non-Tramp, file name."
(goto-char (point-min))
(forward-line)
(when (looking-at
- (concat "[[:space:]]*\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)"
- "[[:space:]]+\\([[:digit:]]+\\)"))
+ (rx (* blank) (group (+ digit))
+ (+ blank) (group (+ digit))
+ (+ blank) (group (+ digit))))
(list (string-to-number (match-string 1))
;; The second value is the used size. We need the
;; free size.
@@ -528,16 +564,15 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sudoedit-handle-set-file-times (filename &optional time flag)
"Like `set-file-times' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
(let ((time
(if (or (null time)
(tramp-compat-time-equal-p time tramp-time-doesnt-exist)
(tramp-compat-time-equal-p time tramp-time-dont-know))
- (current-time)
+ nil
time)))
(tramp-sudoedit-send-command
- v "env" "TZ=UTC" "touch" "-t"
+ v "env" "TZ=UTC0" "touch" "-t"
(format-time-string "%Y%m%d%H%M.%S" time t)
(if (eq flag 'nofollow) "-h" "")
(tramp-compat-file-name-unquote localname)))))
@@ -571,19 +606,23 @@ the result will be a local, non-Tramp, file name."
(when (file-remote-p result)
(setq result (tramp-compat-file-name-quote result 'top)))
(tramp-message v 4 "True name of `%s' is `%s'" localname result)
- result))
- 'nohop)))))
+ result)))))))
(defun tramp-sudoedit-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-writable-p"
(if (file-exists-p filename)
- (tramp-sudoedit-send-command
- v "test" "-w" (tramp-compat-file-name-unquote localname))
- (let ((dir (file-name-directory filename)))
- (and (file-exists-p dir)
- (file-writable-p dir)))))))
+ (if (tramp-file-property-p v localname "file-attributes")
+ ;; Examine `file-attributes' cache to see if request can
+ ;; be satisfied without remote operation.
+ (tramp-check-cached-permissions v ?w)
+ (tramp-sudoedit-send-command
+ v "test" "-w" (tramp-compat-file-name-unquote localname)))
+ ;; If file doesn't exist, check if directory is writable.
+ (and
+ (file-directory-p (file-name-directory filename))
+ (file-writable-p (file-name-directory filename)))))))
(defun tramp-sudoedit-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
@@ -608,41 +647,38 @@ the result will be a local, non-Tramp, file name."
If TARGET is a non-Tramp file, it is used verbatim as the target
of the symlink. If TARGET is a Tramp file, only the localname
component is used as the target of the symlink."
- (if (not (tramp-tramp-file-p (expand-file-name linkname)))
- (tramp-run-real-handler
- #'make-symbolic-link (list target linkname ok-if-already-exists))
-
- (with-parsed-tramp-file-name linkname nil
- ;; If TARGET is a Tramp name, use just the localname component.
- ;; Don't check for a proper method.
- (let ((non-essential t))
- (when (and (tramp-tramp-file-p target)
- (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
- (setq target (tramp-file-local-name (expand-file-name target)))))
-
- ;; If TARGET is still remote, quote it.
- (if (tramp-tramp-file-p target)
- (make-symbolic-link (tramp-compat-file-name-quote target 'top)
- linkname ok-if-already-exists)
+ (with-parsed-tramp-file-name (expand-file-name linkname) nil
+ ;; If TARGET is a Tramp name, use just the localname component.
+ ;; Don't check for a proper method.
+ (let ((non-essential t))
+ (when (and (tramp-tramp-file-p target)
+ (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
+ (setq target (tramp-file-local-name (expand-file-name target)))))
+
+ ;; If TARGET is still remote, quote it.
+ (if (tramp-tramp-file-p target)
+ (make-symbolic-link
+ (tramp-compat-file-name-quote target 'top)
+ linkname ok-if-already-exists)
+
+ ;; Do the 'confirm if exists' thing.
+ (when (file-exists-p linkname)
+ ;; What to do?
+ (if (or (null ok-if-already-exists) ; not allowed to exist
+ (and (numberp ok-if-already-exists)
+ (not
+ (yes-or-no-p
+ (format
+ "File %s already exists; make it a link anyway?"
+ localname)))))
+ (tramp-error v 'file-already-exists localname)
+ (delete-file linkname)))
- ;; Do the 'confirm if exists' thing.
- (when (file-exists-p linkname)
- ;; What to do?
- (if (or (null ok-if-already-exists) ; not allowed to exist
- (and (numberp ok-if-already-exists)
- (not
- (yes-or-no-p
- (format
- "File %s already exists; make it a link anyway?"
- localname)))))
- (tramp-error v 'file-already-exists localname)
- (delete-file linkname)))
-
- (tramp-flush-file-properties v localname)
- (tramp-sudoedit-send-command
- v "ln" "-sf"
- (tramp-compat-file-name-unquote target)
- (tramp-compat-file-name-unquote localname))))))
+ (tramp-flush-file-properties v localname)
+ (tramp-sudoedit-send-command
+ v "ln" "-sf"
+ (tramp-compat-file-name-unquote target)
+ (tramp-compat-file-name-unquote localname)))))
(defun tramp-sudoedit-handle-rename-file
(filename newname &optional ok-if-already-exists)
@@ -672,7 +708,7 @@ component is used as the target of the symlink."
(defun tramp-sudoedit-handle-set-file-selinux-context (filename context)
"Like `set-file-selinux-context' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(when (and (consp context)
(tramp-sudoedit-remote-selinux-p v))
(let ((user (and (stringp (nth 0 context)) (nth 0 context)))
@@ -692,63 +728,43 @@ component is used as the target of the symlink."
(tramp-flush-file-property v localname "file-selinux-context"))
t)))))
+(defun tramp-sudoedit-handle-get-home-directory (vec &optional user)
+ "The remote home directory for connection VEC as local file name.
+If USER is a string, return its home directory instead of the
+user identified by VEC. If there is no user specified in either
+VEC or USER, or if there is no home directory, return nil."
+ (expand-file-name (concat "~" (or user (tramp-file-name-user vec)))))
+
(defun tramp-sudoedit-handle-get-remote-uid (vec id-format)
"The uid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
- (if (equal id-format 'integer)
- (tramp-sudoedit-send-command-and-read vec "id" "-u")
- (tramp-sudoedit-send-command-string vec "id" "-un")))
+ (tramp-sudoedit-send-command vec "id")
+ (tramp-read-id-output vec)
+ (tramp-get-connection-property vec (format "uid-%s" id-format)))
(defun tramp-sudoedit-handle-get-remote-gid (vec id-format)
"The gid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
- (if (equal id-format 'integer)
- (tramp-sudoedit-send-command-and-read vec "id" "-g")
- (tramp-sudoedit-send-command-string vec "id" "-gn")))
+ (tramp-sudoedit-send-command vec "id")
+ (tramp-read-id-output vec)
+ (tramp-get-connection-property vec (format "gid-%s" id-format)))
+
+(defun tramp-sudoedit-handle-get-remote-groups (vec id-format)
+ "Like `tramp-get-remote-groups' for Tramp files.
+ID-FORMAT valid values are `string' and `integer'."
+ (tramp-sudoedit-send-command vec "id")
+ (tramp-read-id-output vec)
+ (tramp-get-connection-property vec (format "groups-%s" id-format)))
(defun tramp-sudoedit-handle-set-file-uid-gid (filename &optional uid gid)
"Like `tramp-set-file-uid-gid' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (tramp-sudoedit-send-command
- v "chown"
- (format "%d:%d"
- (or uid (tramp-get-remote-uid v 'integer))
- (or gid (tramp-get-remote-gid v 'integer)))
- (tramp-unquote-file-local-name filename))))
-
-(defun tramp-sudoedit-handle-write-region
- (start end filename &optional append visit lockname mustbenew)
- "Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename))
- (with-parsed-tramp-file-name filename nil
- (let* ((uid (or (tramp-compat-file-attribute-user-id
- (file-attributes filename 'integer))
- (tramp-get-remote-uid v 'integer)))
- (gid (or (tramp-compat-file-attribute-group-id
- (file-attributes filename 'integer))
- (tramp-get-remote-gid v 'integer)))
- (flag (and (eq mustbenew 'excl) 'nofollow))
- (modes (tramp-default-file-modes filename flag))
- (attributes (file-extended-attributes filename)))
- (prog1
- (tramp-handle-write-region
- start end filename append visit lockname mustbenew)
-
- ;; Set the ownership, modes and extended attributes. This is
- ;; not performed in `tramp-handle-write-region'.
- (unless (and (= (tramp-compat-file-attribute-user-id
- (file-attributes filename 'integer))
- uid)
- (= (tramp-compat-file-attribute-group-id
- (file-attributes filename 'integer))
- gid))
- (tramp-set-file-uid-gid filename uid gid))
- (tramp-compat-set-file-modes filename modes flag)
- ;; We ignore possible errors, because ACL strings could be
- ;; incompatible.
- (when attributes
- (ignore-errors
- (set-file-extended-attributes filename attributes)))))))
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
+ (tramp-sudoedit-send-command
+ v "chown"
+ (format "%d:%d"
+ (or uid (tramp-get-remote-uid v 'integer))
+ (or gid (tramp-get-remote-gid v 'integer)))
+ (tramp-unquote-file-local-name filename))))
;; Internal functions.
@@ -765,7 +781,7 @@ ID-FORMAT valid values are `string' and `integer'."
(delete-region (point-min) (point))
;; Delete empty lines.
(goto-char (point-min))
- (while (and (not (eobp)) (= (point) (point-at-eol)))
+ (while (and (not (eobp)) (= (point) (line-end-position)))
(forward-line))
(delete-region (point-min) (point))
(tramp-message vec 3 "Process has finished.")
@@ -827,6 +843,7 @@ in case of error, t otherwise."
(process-put p 'vector vec)
(process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil)
+ (tramp-set-connection-property p "password-vector"
tramp-sudoedit-null-hop)
(tramp-process-actions p vec nil tramp-sudoedit-sudo-actions)
(tramp-message vec 6 "%s\n%s" (process-exit-status p) (buffer-string))
(prog1
@@ -853,7 +870,7 @@ In case there is no valid Lisp expression, it raises an
error."
(condition-case nil
(prog1 (read (current-buffer))
;; Error handling.
- (when (re-search-forward "\\S-" (point-at-eol) t)
+ (when (re-search-forward (rx (not blank)) (line-end-position) t)
(error nil)))
(error (tramp-error
vec 'file-error
@@ -867,7 +884,7 @@ In case there is no valid Lisp expression, it raises an
error."
(tramp-message vec 6 "\n%s" (buffer-string))
(goto-char (point-max))
;(delete-blank-lines)
- (while (looking-back "[ \t\n]+" nil 'greedy)
+ (while (looking-back (rx (+ (any " \t\n"))) nil 'greedy)
(delete-region (match-beginning 0) (point)))
(when (> (point-max) (point-min))
(substring-no-properties (buffer-string))))))
diff --git a/tramp-uu.el b/tramp-uu.el
index e849c36d13..2bbdb299a6 100644
--- a/tramp-uu.el
+++ b/tramp-uu.el
@@ -25,7 +25,7 @@
;;; Commentary:
;; An implementation of "uuencode" in Lisp. Uses the function
-;; base64-encode-region which is built-in to modern Emacsen.
+;; base64-encode-region which is built-in to modern Emacs.
;;; Code:
diff --git a/tramp.el b/tramp.el
index 91dfb5c3c8..ca8963fbf5 100644
--- a/tramp.el
+++ b/tramp.el
@@ -64,7 +64,8 @@
(declare-function netrc-parse "netrc")
(defvar auto-save-file-name-transforms)
-;; Reload `tramp-compat' when we reload `tramp-autoloads' of the GNU ELPA
package.
+;; Reload `tramp-compat' when we reload `tramp-autoloads' of the GNU
+;; ELPA package.
;;;###autoload (when (featurep 'tramp-compat)
;;;###autoload (load "tramp-compat" 'noerror 'nomessage))
@@ -77,7 +78,8 @@
:link '(custom-manual "(tramp)Top")
:version "22.1")
-(eval-and-compile ;; So it's also available in tramp-loaddefs.el!
+;;;###tramp-autoload
+(progn
(defvar tramp--startup-hook nil
"Forms to be executed at the end of tramp.el.")
(put 'tramp--startup-hook 'tramp-suppress-trace t)
@@ -95,6 +97,7 @@
If it is set to nil, all remote file names are used literally."
:type 'boolean)
+;;;###tramp-autoload
(defcustom tramp-verbose 3
"Verbosity level for Tramp messages.
Any level x includes messages for all levels 1 .. x-1. The levels are
@@ -186,9 +189,11 @@ See the variable `tramp-encoding-shell' for more
information."
;; Since Emacs 26.1, `system-name' can return nil at build time if
;; Emacs is compiled with "--no-build-details". We do expect it to be
;; a string. (Bug#44481, Bug#54294)
+;;;###tramp-autoload
(defconst tramp-system-name (or (system-name) "")
"The system name Tramp is running locally.")
+;;;###tramp-autoload
(defvar tramp-methods nil
"Alist of methods for remote files.
This is a list of entries of the form (NAME PARAM1 PARAM2 ...).
@@ -200,9 +205,9 @@ pair of the form (KEY VALUE). The following KEYs are
defined:
MUST be a Bourne-like shell. It is normally not necessary to
set this to any value other than \"/bin/sh\": Tramp wants to
use a shell which groks tilde expansion, but it can search
- for it. Also note that \"/bin/sh\" exists on all Unixen,
- this might not be true for the value that you decide to use.
- You Have Been Warned.
+ for it. Also note that \"/bin/sh\" exists on all Unixen
+ except Andtoid, this might not be true for the value that you
+ decide to use. You Have Been Warned.
* `tramp-remote-shell-login'
This specifies the arguments to let `tramp-remote-shell' run
@@ -257,6 +262,8 @@ pair of the form (KEY VALUE). The following KEYs are
defined:
argument if it is supported.
- \"%y\" is replaced by the `tramp-scp-force-scp-protocol'
argument if it is supported.
+ - \"%z\" is replaced by the `tramp-scp-direct-remote-copying'
+ argument if it is supported.
- \"%d\" is replaced by the device detected by `tramp-adb-get-device'.
The existence of `tramp-login-args', combined with the
@@ -271,7 +278,16 @@ pair of the form (KEY VALUE). The following KEYs are
defined:
* `tramp-direct-async'
Whether the method supports direct asynchronous processes.
- Until now, just \"ssh\"-based and \"adb\"-based methods do.
+ Until now, just \"ssh\"-based, \"sshfs\"-based, \"adb\"-based
+ and container methods do. If it is a list of strings, they
+ are used to construct the remote command.
+
+ * `tramp-config-check'
+ A function to be called with one argument, VEC. It should
+ return a string which is used to check, whether the
+ configuration of the remote host has been changed (which
+ would require to flush the cache data). This string is kept
+ as connection property \"config-check-data\".
* `tramp-copy-program'
This specifies the name of the program to use for remotely copying
@@ -316,14 +332,20 @@ pair of the form (KEY VALUE). The following KEYs are
defined:
* `tramp-connection-timeout'
This is the maximum time to be spent for establishing a connection.
In general, the global default value shall be used, but for
- some methods, like \"su\" or \"sudo\", a shorter timeout
- might be desirable.
+ some methods, like \"doas\", \"su\" or \"sudo\", a shorter
+ timeout might be desirable.
* `tramp-session-timeout'
How long a Tramp connection keeps open before being disconnected.
- This is useful for methods like \"su\" or \"sudo\", which
+ This is useful for methods like \"doas\" or \"sudo\", which
shouldn't run an open connection in the background forever.
+ * `tramp-password-previous-hop'
+ The password for this connection is the same like the
+ password for the previous hop. If there is no previous hop,
+ the password of the local user is applied. This is needed
+ for methods like \"doas\", \"sudo\" or \"sudoedit\".
+
* `tramp-case-insensitive'
Whether the remote file system handles file names case insensitive.
Only a non-nil value counts, the default value nil means to
@@ -396,6 +418,7 @@ See `tramp-methods' for possibilities.
Also see `tramp-default-method-alist'."
:type 'string)
+;;;###tramp-autoload
(defcustom tramp-default-method-alist nil
;; FIXME: This is not an "alist", because its elements are not of
;; the form (KEY . VAL) but (KEY1 KEY2 VAL).
@@ -425,6 +448,7 @@ It is nil by default; otherwise settings in configuration
files like
This variable is regarded as obsolete, and will be removed soon."
:type '(choice (const nil) string))
+;;;###tramp-autoload
(defcustom tramp-default-user-alist nil
;; FIXME: This is not an "alist", because its elements are not of
;; the form (KEY . VAL) but (KEY1 KEY2 VAL).
@@ -446,6 +470,7 @@ empty string for the method name."
Useful for su and sudo methods mostly."
:type 'string)
+;;;###tramp-autoload
(defcustom tramp-default-host-alist nil
;; FIXME: This is not an "alist", because its elements are not of
;; the form (KEY . VAL) but (KEY1 KEY2 VAL).
@@ -499,10 +524,11 @@ interpreted as a regular expression which always matches."
;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=38079#20>.
(defcustom tramp-restricted-shell-hosts-alist
(when (and (eq system-type 'windows-nt)
- (not (string-match-p "sh$" tramp-encoding-shell)))
- (list (format "\\`\\(%s\\|%s\\)\\'"
- (regexp-quote (downcase tramp-system-name))
- (regexp-quote (upcase tramp-system-name)))))
+ (not (string-match-p (rx "sh" eol) tramp-encoding-shell)))
+ (list (tramp-compat-rx
+ bos (| (literal (downcase tramp-system-name))
+ (literal (upcase tramp-system-name)))
+ eos)))
"List of hosts, which run a restricted shell.
This is a list of regular expressions, which denote hosts running
a restricted shell like \"rbash\". Those hosts can be used as
@@ -511,15 +537,16 @@ host runs a restricted shell, it shall be added to this
list, too."
:version "27.1"
:type '(repeat (regexp :tag "Host regexp")))
+;;;###tramp-autoload
(defcustom tramp-local-host-regexp
- (concat
- "\\`"
- (regexp-opt
- (list "localhost" "localhost6" tramp-system-name "127.0.0.1" "::1") t)
- "\\'")
+ (tramp-compat-rx
+ bos
+ (| (literal tramp-system-name)
+ (| "localhost" "localhost4" "localhost6" "127.0.0.1" "::1"))
+ eos)
"Host names which are regarded as local host.
If the local host runs a chrooted environment, set this to nil."
- :version "27.1"
+ :version "29.1"
:type '(choice (const :tag "Chrooted environment" nil)
(regexp :tag "Host regexp")))
@@ -563,8 +590,9 @@ followed by an equal number of backspaces to erase them will
usually suffice.")
(defconst tramp-echoed-echo-mark-regexp
- (format "%s\\(\b\\( \b\\)?\\)\\{%d\\}"
- tramp-echo-mark-marker tramp-echo-mark-marker-length)
+ (rx-to-string
+ `(: ,tramp-echo-mark-marker
+ (= ,tramp-echo-mark-marker-length "\b" (? " \b"))))
"Regexp which matches `tramp-echo-mark' as it gets echoed by \
the remote shell.")
@@ -581,7 +609,7 @@ if you need to change this."
:type 'string)
(defcustom tramp-login-prompt-regexp
- ".*\\(user\\|login\\)\\( .*\\)?: *"
+ (rx (* nonl) (| "user" "login") (? blank (* nonl)) ":" (* blank))
"Regexp matching login-like prompts.
The regexp should match at end of buffer.
@@ -593,8 +621,11 @@ Sometimes the prompt is reported to look like \"login
as:\"."
;; displayed at the beginning of the line (and Zsh uses it).
;; Allow also [] style prompts. They can appear only during
;; connection initialization; Tramp redefines the prompt afterwards.
- (concat "\\(?:^\\|\r\\)"
- "[^]#$%>\n]*#?[]#$%>] *\\(\e\\[[[:digit:];]*[[:alpha:]] *\\)*")
+ (rx (| bol "\r")
+ (* (not (any "\n#$%>]")))
+ (? "#") (any "#$%>]") (* blank)
+ ;; Escape characters.
+ (* "[" (* (any ";" digit)) alpha (* blank)))
"Regexp to match prompts from remote shell.
Normally, Tramp expects you to configure `shell-prompt-pattern'
correctly, but sometimes it happens that you are connecting to a
@@ -609,7 +640,10 @@ This regexp must match both `tramp-initial-end-of-output'
and
:type 'regexp)
(defcustom tramp-password-prompt-regexp
- (format "^.*\\(%s\\).*:\^@? *" (regexp-opt password-word-equivalents))
+ (tramp-compat-rx
+ bol (* nonl)
+ (group (regexp (regexp-opt password-word-equivalents)))
+ (* nonl) ":" (? "\^@") (* blank))
"Regexp matching password-like prompts.
The regexp should match at end of buffer.
@@ -623,36 +657,26 @@ The `sudo' program appears to insert a `^@' character
into the prompt."
:type 'regexp)
(defcustom tramp-wrong-passwd-regexp
- (concat "^.*"
- ;; These strings should be on the last line
- (regexp-opt '("Permission denied"
- "Login incorrect"
- "Login Incorrect"
- "Connection refused"
- "Connection closed"
- "Timeout, server not responding."
- "Sorry, try again."
- "Name or service not known"
- "Host key verification failed."
- "No supported authentication methods left to try!")
- t)
- ".*"
- "\\|"
- "^.*\\("
- ;; Here comes a list of regexes, separated by \\|
- "Received signal [[:digit:]]+"
- "\\).*")
+ (rx bol (* nonl)
+ (| "Permission denied"
+ "Login [Ii]ncorrect"
+ "Connection refused"
+ "Connection closed"
+ "Timeout, server not responding."
+ "Sorry, try again."
+ "Name or service not known"
+ "Host key verification failed."
+ "No supported authentication methods left to try!"
+ (: "Received signal " (+ digit)))
+ (* nonl))
"Regexp matching a `login failed' message.
The regexp should match at end of buffer."
:type 'regexp)
(defcustom tramp-yesno-prompt-regexp
- (concat
- (regexp-opt
- '("Are you sure you want to continue connecting (yes/no)?"
- "Are you sure you want to continue connecting (yes/no/[fingerprint])?")
- t)
- "\\s-*")
+ (rx "Are you sure you want to continue connecting (yes/no"
+ (? "/[fingerprint]") ")?"
+ (* blank))
"Regular expression matching all yes/no queries which need to be confirmed.
The confirmation should be done with yes or no.
The regexp should match at end of buffer.
@@ -660,17 +684,16 @@ See also `tramp-yn-prompt-regexp'."
:type 'regexp)
(defcustom tramp-yn-prompt-regexp
- (concat
- (regexp-opt '("Store key in cache? (y/n)"
- "Update cached key? (y/n, Return cancels connection)")
- t)
- "\\s-*")
+ (rx (| "Store key in cache? (y/n)"
+ "Update cached key? (y/n, Return cancels connection)")
+ (* blank))
"Regular expression matching all y/n queries which need to be confirmed.
The confirmation should be done with y or n.
The regexp should match at end of buffer.
See also `tramp-yesno-prompt-regexp'."
:type 'regexp)
+;;;###tramp-autoload
(defcustom tramp-terminal-type "dumb"
"Value of TERM environment variable for logging in to remote host.
Because Tramp wants to parse the output of the remote shell, it is easily
@@ -680,11 +703,9 @@ files conditionalize this setup based on the TERM
environment variable."
:type 'string)
(defcustom tramp-terminal-prompt-regexp
- (concat "\\("
- "TERM = (.*)"
- "\\|"
- "Terminal type\\? \\[.*\\]"
- "\\)\\s-*")
+ (rx (| (: "TERM = (" (* nonl) ")")
+ (: "Terminal type? [" (* nonl) "]"))
+ (* blank))
"Regular expression matching all terminal setting prompts.
The regexp should match at end of buffer.
The answer will be provided by `tramp-action-terminal', which see."
@@ -695,7 +716,7 @@ The answer will be provided by `tramp-action-terminal',
which see."
;; "-no-antispoof". However, since we don't know which PuTTY
;; version is installed, we must react interactively.
(defcustom tramp-antispoof-regexp
- (regexp-quote "Access granted. Press Return to begin session. ")
+ (rx "Access granted. Press Return to begin session. ")
"Regular expression matching plink's anti-spoofing message.
The regexp should match at end of buffer."
:version "27.1"
@@ -705,42 +726,42 @@ The regexp should match at end of buffer."
;; with their finger. We must tell it to the user.
;; Added in OpenSSH 8.2. I've tested it with yubikey.
(defcustom tramp-security-key-confirm-regexp
- "^\r*Confirm user presence for key .*[\r\n]*"
+ (rx bol (* "\r") "Confirm user presence for key " (* nonl) (* (any "\r\n")))
"Regular expression matching security key confirmation message.
The regexp should match at end of buffer."
:version "28.1"
:type 'regexp)
(defcustom tramp-security-key-confirmed-regexp
- "^\r*User presence confirmed[\r\n]*"
+ (rx bol (* "\r") "User presence confirmed" (* (any "\r\n")))
"Regular expression matching security key confirmation message.
The regexp should match at end of buffer."
:version "28.1"
:type 'regexp)
(defcustom tramp-security-key-timeout-regexp
- "^\r*sign_and_send_pubkey: signing failed for .*[\r\n]*"
+ (rx bol (* "\r") "sign_and_send_pubkey: signing failed for "
+ (* nonl) (* (any "\r\n")))
"Regular expression matching security key timeout message.
The regexp should match at end of buffer."
:version "28.1"
:type 'regexp)
(defcustom tramp-operation-not-permitted-regexp
- (concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*"
- (regexp-opt '("Operation not permitted") t))
+ (rx (| (: "preserving times" (* nonl)) "set mode") ":" (* blank)
+ "Operation not permitted")
"Regular expression matching keep-date problems in (s)cp operations.
Copying has been performed successfully already, so this message can
be ignored safely."
:type 'regexp)
(defcustom tramp-copy-failed-regexp
- (concat "\\(.+: "
- (regexp-opt '("Permission denied"
- "not a regular file"
- "is a directory"
- "No such file or directory")
- t)
- "\\)\\s-*")
+ (rx (+ nonl) ": "
+ (| "No such file or directory"
+ "Permission denied"
+ "is a directory"
+ "not a regular file")
+ (* blank))
"Regular expression matching copy problems in (s)cp operations."
:type 'regexp)
@@ -755,11 +776,11 @@ The answer will be provided by
`tramp-action-process-alive',
(defconst tramp-temp-name-prefix "tramp."
"Prefix to use for temporary files.
-If this is a relative file name (such as \"tramp.\"), it is considered
-relative to the directory name returned by the function
-`tramp-compat-temporary-file-directory' (which see). It may also be an
-absolute file name; don't forget to include a prefix for the filename
-part, though.")
+If this is a relative file name (such as \"tramp.\"), it is
+considered relative to the directory name returned by the
+function `temporary-file-directory' (which see). It may also be
+an absolute file name; don't forget to include a prefix for the
+filename part, though.")
(defconst tramp-temp-buffer-name " *tramp temp*"
"Buffer name for a temporary buffer.
@@ -791,6 +812,23 @@ Customize. See also `tramp-change-syntax'."
:initialize #'custom-initialize-default
:set #'tramp-set-syntax)
+(defvar tramp-prefix-format)
+(defvar tramp-prefix-regexp)
+(defvar tramp-method-regexp)
+(defvar tramp-postfix-method-format)
+(defvar tramp-postfix-method-regexp)
+(defvar tramp-prefix-ipv6-format)
+(defvar tramp-prefix-ipv6-regexp)
+(defvar tramp-postfix-ipv6-format)
+(defvar tramp-postfix-ipv6-regexp)
+(defvar tramp-postfix-host-format)
+(defvar tramp-postfix-host-regexp)
+(defvar tramp-remote-file-name-spec-regexp)
+(defvar tramp-file-name-structure)
+(defvar tramp-file-name-regexp)
+(defvar tramp-completion-method-regexp)
+(defvar tramp-completion-file-name-regexp)
+
(defun tramp-set-syntax (symbol value)
"Set SYMBOL to value VALUE.
Used in user option `tramp-syntax'. There are further variables
@@ -804,33 +842,33 @@ to be set, depending on VALUE."
;; Set the value:
(set-default symbol value)
;; Reset the depending variables.
- (with-no-warnings
- (setq tramp-prefix-format (tramp-build-prefix-format)
- tramp-prefix-regexp (tramp-build-prefix-regexp)
- tramp-method-regexp (tramp-build-method-regexp)
- tramp-postfix-method-format (tramp-build-postfix-method-format)
- tramp-postfix-method-regexp (tramp-build-postfix-method-regexp)
- tramp-prefix-ipv6-format (tramp-build-prefix-ipv6-format)
- tramp-prefix-ipv6-regexp (tramp-build-prefix-ipv6-regexp)
- tramp-postfix-ipv6-format (tramp-build-postfix-ipv6-format)
- tramp-postfix-ipv6-regexp (tramp-build-postfix-ipv6-regexp)
- tramp-postfix-host-format (tramp-build-postfix-host-format)
- tramp-postfix-host-regexp (tramp-build-postfix-host-regexp)
- tramp-remote-file-name-spec-regexp
- (tramp-build-remote-file-name-spec-regexp)
- tramp-file-name-structure (tramp-build-file-name-structure)
- tramp-file-name-regexp (tramp-build-file-name-regexp)
- tramp-completion-file-name-regexp
- (tramp-build-completion-file-name-regexp)))
+ (setq tramp-prefix-format (tramp-build-prefix-format)
+ tramp-prefix-regexp (tramp-build-prefix-regexp)
+ tramp-method-regexp (tramp-build-method-regexp)
+ tramp-postfix-method-format (tramp-build-postfix-method-format)
+ tramp-postfix-method-regexp (tramp-build-postfix-method-regexp)
+ tramp-prefix-ipv6-format (tramp-build-prefix-ipv6-format)
+ tramp-prefix-ipv6-regexp (tramp-build-prefix-ipv6-regexp)
+ tramp-postfix-ipv6-format (tramp-build-postfix-ipv6-format)
+ tramp-postfix-ipv6-regexp (tramp-build-postfix-ipv6-regexp)
+ tramp-postfix-host-format (tramp-build-postfix-host-format)
+ tramp-postfix-host-regexp (tramp-build-postfix-host-regexp)
+ tramp-remote-file-name-spec-regexp
+ (tramp-build-remote-file-name-spec-regexp)
+ tramp-file-name-structure (tramp-build-file-name-structure)
+ tramp-file-name-regexp (tramp-build-file-name-regexp)
+ tramp-completion-method-regexp
+ (tramp-build-completion-method-regexp)
+ tramp-completion-file-name-regexp
+ (tramp-build-completion-file-name-regexp))
;; Rearrange file name handlers.
(tramp-register-file-name-handlers))
;; Initialize the Tramp syntax variables. We want to override initial
-;; value of `tramp-file-name-regexp'. Other Tramp syntax variables
-;; must be initialized as well to proper values. We do not call
+;; value of `tramp-file-name-regexp'. We do not call
;; `custom-set-variable', this would load Tramp via custom.el.
(tramp--with-startup
- (tramp-set-syntax 'tramp-syntax (tramp-compat-tramp-syntax)))
+ (tramp-set-syntax 'tramp-syntax tramp-syntax))
(defun tramp-syntax-values ()
"Return possible values of `tramp-syntax', a list."
@@ -840,9 +878,9 @@ to be set, depending on VALUE."
values))
(defun tramp-lookup-syntax (alist)
- "Look up a syntax string in ALIST according to `tramp-compat-tramp-syntax'.
-Raise an error if `tramp-syntax' is invalid."
- (or (cdr (assq (tramp-compat-tramp-syntax) alist))
+ "Look up a syntax string in ALIST according to `tramp-syntax'.
+Raise an error if it is invalid."
+ (or (cdr (assq tramp-syntax alist))
(error "Wrong `tramp-syntax' %s" tramp-syntax)))
(defconst tramp-prefix-format-alist
@@ -855,30 +893,32 @@ Raise an error if `tramp-syntax' is invalid."
"Return `tramp-prefix-format' according to `tramp-syntax'."
(tramp-lookup-syntax tramp-prefix-format-alist))
-(defvar tramp-prefix-format nil ;Initialized when defining `tramp-syntax'!
+(defvar tramp-prefix-format nil ; Initialized when defining `tramp-syntax'!
"String matching the very beginning of Tramp file names.
Used in `tramp-make-tramp-file-name'.")
(defun tramp-build-prefix-regexp ()
"Return `tramp-prefix-regexp'."
- (concat "^" (regexp-quote tramp-prefix-format)))
+ (tramp-compat-rx bol (literal (tramp-build-prefix-format))))
-(defvar tramp-prefix-regexp nil ;Initialized when defining `tramp-syntax'!
+(defvar tramp-prefix-regexp nil ; Initialized when defining `tramp-syntax'!
"Regexp matching the very beginning of Tramp file names.
Should always start with \"^\". Derived from `tramp-prefix-format'.")
(defconst tramp-method-regexp-alist
- '((default . "[[:alnum:]-]+")
+ `((default . ,(tramp-compat-rx
+ (| (literal tramp-default-method-marker) (>= 2 alnum))))
(simplified . "")
- (separate . "[[:alnum:]-]*"))
+ (separate . ,(tramp-compat-rx
+ (? (| (literal tramp-default-method-marker) (>= 2 alnum))))))
"Alist mapping Tramp syntax to regexps matching methods identifiers.")
(defun tramp-build-method-regexp ()
"Return `tramp-method-regexp' according to `tramp-syntax'."
(tramp-lookup-syntax tramp-method-regexp-alist))
-(defvar tramp-method-regexp nil ;Initialized when defining `tramp-syntax'!
- "Regexp matching methods identifiers.
+(defvar tramp-method-regexp nil ; Initialized when defining `tramp-syntax'!
+ "Regexp matching method identifiers.
The `ftp' syntax does not support methods.")
(defconst tramp-postfix-method-format-alist
@@ -891,47 +931,50 @@ The `ftp' syntax does not support methods.")
"Return `tramp-postfix-method-format' according to `tramp-syntax'."
(tramp-lookup-syntax tramp-postfix-method-format-alist))
-(defvar tramp-postfix-method-format nil ;Init'd when defining `tramp-syntax'!
+(defvar tramp-postfix-method-format nil ; Init'd when defining `tramp-syntax'!
"String matching delimiter between method and user or host names.
The `ftp' syntax does not support methods.
Used in `tramp-make-tramp-file-name'.")
(defun tramp-build-postfix-method-regexp ()
"Return `tramp-postfix-method-regexp'."
- (regexp-quote tramp-postfix-method-format))
+ (tramp-compat-rx (literal (tramp-build-postfix-method-format))))
-(defvar tramp-postfix-method-regexp nil ;Init'd when defining `tramp-syntax'!
+(defvar tramp-postfix-method-regexp nil ; Init'd when defining `tramp-syntax'!
"Regexp matching delimiter between method and user or host names.
Derived from `tramp-postfix-method-format'.")
-(defconst tramp-user-regexp "[^/|: \t]+"
+(defconst tramp-user-regexp (rx (+ (not (any "/:|" blank))))
"Regexp matching user names.")
(defconst tramp-prefix-domain-format "%"
"String matching delimiter between user and domain names.")
-(defconst tramp-prefix-domain-regexp (regexp-quote tramp-prefix-domain-format)
+(defconst tramp-prefix-domain-regexp
+ (tramp-compat-rx (literal tramp-prefix-domain-format))
"Regexp matching delimiter between user and domain names.
Derived from `tramp-prefix-domain-format'.")
-(defconst tramp-domain-regexp "[[:alnum:]_.-]+"
+(defconst tramp-domain-regexp (rx (+ (any "._-" alnum)))
"Regexp matching domain names.")
(defconst tramp-user-with-domain-regexp
- (concat "\\(" tramp-user-regexp "\\)"
- tramp-prefix-domain-regexp
- "\\(" tramp-domain-regexp "\\)")
+ (tramp-compat-rx
+ (group (regexp tramp-user-regexp))
+ (regexp tramp-prefix-domain-regexp)
+ (group (regexp tramp-domain-regexp)))
"Regexp matching user names with domain names.")
(defconst tramp-postfix-user-format "@"
"String matching delimiter between user and host names.
Used in `tramp-make-tramp-file-name'.")
-(defconst tramp-postfix-user-regexp (regexp-quote tramp-postfix-user-format)
+(defconst tramp-postfix-user-regexp
+ (tramp-compat-rx (literal tramp-postfix-user-format))
"Regexp matching delimiter between user and host names.
Derived from `tramp-postfix-user-format'.")
-(defconst tramp-host-regexp "[[:alnum:]_.%-]+"
+(defconst tramp-host-regexp (rx (+ (any "%._-" alnum)))
"Regexp matching host names.")
(defconst tramp-prefix-ipv6-format-alist
@@ -944,22 +987,22 @@ Derived from `tramp-postfix-user-format'.")
"Return `tramp-prefix-ipv6-format' according to `tramp-syntax'."
(tramp-lookup-syntax tramp-prefix-ipv6-format-alist))
-(defvar tramp-prefix-ipv6-format nil ;Initialized when defining `tramp-syntax'!
+(defvar tramp-prefix-ipv6-format nil ; Initialized when defining
`tramp-syntax'!
"String matching left hand side of IPv6 addresses.
Used in `tramp-make-tramp-file-name'.")
(defun tramp-build-prefix-ipv6-regexp ()
"Return `tramp-prefix-ipv6-regexp'."
- (regexp-quote tramp-prefix-ipv6-format))
+ (tramp-compat-rx (literal tramp-prefix-ipv6-format)))
-(defvar tramp-prefix-ipv6-regexp nil ;Initialized when defining `tramp-syntax'!
+(defvar tramp-prefix-ipv6-regexp nil ; Initialized when defining
`tramp-syntax'!
"Regexp matching left hand side of IPv6 addresses.
Derived from `tramp-prefix-ipv6-format'.")
;; The following regexp is a bit sloppy. But it shall serve our
;; purposes. It covers also IPv4 mapped IPv6 addresses, like in
;; "::ffff:192.168.0.1".
-(defconst tramp-ipv6-regexp "\\(?:[[:alnum:]]*:\\)+[[:alnum:].]+"
+(defconst tramp-ipv6-regexp (rx (+ (* alnum) ":") (* (any "." alnum)))
"Regexp matching IPv6 addresses.")
(defconst tramp-postfix-ipv6-format-alist
@@ -972,38 +1015,41 @@ Derived from `tramp-prefix-ipv6-format'.")
"Return `tramp-postfix-ipv6-format' according to `tramp-syntax'."
(tramp-lookup-syntax tramp-postfix-ipv6-format-alist))
-(defvar tramp-postfix-ipv6-format nil ;Initialized when defining
`tramp-syntax'!
+(defvar tramp-postfix-ipv6-format nil ; Initialized when defining
`tramp-syntax'!
"String matching right hand side of IPv6 addresses.
Used in `tramp-make-tramp-file-name'.")
(defun tramp-build-postfix-ipv6-regexp ()
"Return `tramp-postfix-ipv6-regexp'."
- (regexp-quote tramp-postfix-ipv6-format))
+ (tramp-compat-rx (literal tramp-postfix-ipv6-format)))
-(defvar tramp-postfix-ipv6-regexp nil ;Initialized when defining
`tramp-syntax'!
+(defvar tramp-postfix-ipv6-regexp nil ; Initialized when defining
`tramp-syntax'!
"Regexp matching right hand side of IPv6 addresses.
Derived from `tramp-postfix-ipv6-format'.")
(defconst tramp-prefix-port-format "#"
"String matching delimiter between host names and port numbers.")
-(defconst tramp-prefix-port-regexp (regexp-quote tramp-prefix-port-format)
+(defconst tramp-prefix-port-regexp
+ (tramp-compat-rx (literal tramp-prefix-port-format))
"Regexp matching delimiter between host names and port numbers.
Derived from `tramp-prefix-port-format'.")
-(defconst tramp-port-regexp "[[:digit:]]+"
+(defconst tramp-port-regexp (rx (+ digit))
"Regexp matching port numbers.")
(defconst tramp-host-with-port-regexp
- (concat "\\(" tramp-host-regexp "\\)"
- tramp-prefix-port-regexp
- "\\(" tramp-port-regexp "\\)")
+ (tramp-compat-rx
+ (group (regexp tramp-host-regexp))
+ (regexp tramp-prefix-port-regexp)
+ (group (regexp tramp-port-regexp)))
"Regexp matching host names with port numbers.")
(defconst tramp-postfix-hop-format "|"
"String matching delimiter after ad-hoc hop definitions.")
-(defconst tramp-postfix-hop-regexp (regexp-quote tramp-postfix-hop-format)
+(defconst tramp-postfix-hop-regexp
+ (tramp-compat-rx (literal tramp-postfix-hop-format))
"Regexp matching delimiter after ad-hoc hop definitions.
Derived from `tramp-postfix-hop-format'.")
@@ -1017,19 +1063,19 @@ Derived from `tramp-postfix-hop-format'.")
"Return `tramp-postfix-host-format' according to `tramp-syntax'."
(tramp-lookup-syntax tramp-postfix-host-format-alist))
-(defvar tramp-postfix-host-format nil ;Initialized when defining
`tramp-syntax'!
+(defvar tramp-postfix-host-format nil ; Initialized when defining
`tramp-syntax'!
"String matching delimiter between host names and localnames.
Used in `tramp-make-tramp-file-name'.")
(defun tramp-build-postfix-host-regexp ()
"Return `tramp-postfix-host-regexp'."
- (regexp-quote tramp-postfix-host-format))
+ (tramp-compat-rx (literal tramp-postfix-host-format)))
-(defvar tramp-postfix-host-regexp nil ;Initialized when defining
`tramp-syntax'!
+(defvar tramp-postfix-host-regexp nil ; Initialized when defining
`tramp-syntax'!
"Regexp matching delimiter between host names and localnames.
Derived from `tramp-postfix-host-format'.")
-(defconst tramp-localname-regexp "[^\n\r]*\\'"
+(defconst tramp-localname-regexp (rx (* (not (any "\r\n"))) eos)
"Regexp matching localnames.")
(defconst tramp-unknown-id-string "UNKNOWN"
@@ -1038,21 +1084,33 @@ Derived from `tramp-postfix-host-format'.")
(defconst tramp-unknown-id-integer -1
"Integer used to denote an unknown user or group.")
+;;;###tramp-autoload
+(defconst tramp-root-id-string "root"
+ "String used to denote the root user or group.")
+
+(defconst tramp-root-id-integer 0
+ "Integer used to denote the root user or group.")
+
;;; File name format:
(defun tramp-build-remote-file-name-spec-regexp ()
"Construct a regexp matching a Tramp file name for a Tramp syntax.
It is expected, that `tramp-syntax' has the proper value."
- (concat
- "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
- "\\(?:" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?"
- "\\(" "\\(?:" tramp-host-regexp "\\|"
- tramp-prefix-ipv6-regexp "\\(?:" tramp-ipv6-regexp "\\)?"
- tramp-postfix-ipv6-regexp "\\)"
- "\\(?:" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?"))
+ (tramp-compat-rx
+ ;; Method.
+ (group (regexp tramp-method-regexp)) (regexp tramp-postfix-method-regexp)
+ ;; Optional user. This includes domain.
+ (? (group (regexp tramp-user-regexp)) (regexp tramp-postfix-user-regexp))
+ ;; Optional host.
+ (? (group (| (regexp tramp-host-regexp)
+ (: (regexp tramp-prefix-ipv6-regexp)
+ (? (regexp tramp-ipv6-regexp))
+ (regexp tramp-postfix-ipv6-regexp)))
+ ;; Optional port.
+ (? (regexp tramp-prefix-port-regexp) (regexp tramp-port-regexp))))))
(defvar tramp-remote-file-name-spec-regexp
- nil ;Initialized when defining `tramp-syntax'!
+ nil ; Initialized when defining `tramp-syntax'!
"Regular expression matching a Tramp file name between prefix and postfix.")
(defun tramp-build-file-name-structure ()
@@ -1060,15 +1118,16 @@ It is expected, that `tramp-syntax' has the proper
value."
It is expected, that `tramp-syntax' has the proper value.
See `tramp-file-name-structure'."
(list
- (concat
- tramp-prefix-regexp
- "\\(" "\\(?:" tramp-remote-file-name-spec-regexp
- tramp-postfix-hop-regexp "\\)+" "\\)?"
- tramp-remote-file-name-spec-regexp tramp-postfix-host-regexp
- "\\(" tramp-localname-regexp "\\)")
+ (tramp-compat-rx
+ (regexp tramp-prefix-regexp)
+ (? (group (+ (regexp tramp-remote-file-name-spec-regexp)
+ (regexp tramp-postfix-hop-regexp))))
+ (regexp tramp-remote-file-name-spec-regexp)
+ (regexp tramp-postfix-host-regexp)
+ (group (regexp tramp-localname-regexp)))
5 6 7 8 1))
-(defvar tramp-file-name-structure nil ;Initialized when defining
`tramp-syntax'!
+(defvar tramp-file-name-structure nil ; Initialized when defining
`tramp-syntax'!
"List detailing the Tramp file name structure.
This is a list of six elements (REGEXP METHOD USER HOST FILE HOP).
@@ -1093,7 +1152,8 @@ See also `tramp-file-name-regexp'.")
(car tramp-file-name-structure))
;;;###autoload
-(defconst tramp-initial-file-name-regexp "\\`/[^/:]+:[^/:]*:"
+(defconst tramp-initial-file-name-regexp
+ (rx bos "/" (+ (not (any "/:"))) ":" (* (not (any "/:"))) ":")
"Value for `tramp-file-name-regexp' for autoload.
It must match the initial `tramp-syntax' settings.")
@@ -1110,78 +1170,60 @@ initial value is overwritten by the car of
`tramp-file-name-structure'.")
:version "27.1"
:type '(choice (const nil) regexp))
-(defconst tramp-completion-file-name-regexp-default
- (concat
- "\\`"
- ;; `file-name-completion' uses absolute paths for matching. This
- ;; means that on W32 systems, something like "/ssh:host:~/path"
- ;; becomes "c:/ssh:host:~/path". See also `tramp-drop-volume-letter'.
- (when (eq system-type 'windows-nt)
- "\\(?:[[:alpha:]]:\\)?")
- "/\\("
- ;; Optional multi hop.
- "\\([^/|:]+:[^/|:]*|\\)*"
- ;; Last hop.
- (if (memq system-type '(cygwin windows-nt))
- ;; The method is either "-", or at least two characters.
- "\\(-\\|[^/|:]\\{2,\\}\\)"
- ;; At least one character for method.
- "[^/|:]+")
- ;; Method separator, user name and host name.
- "\\(:[^/|:]*\\)?"
- "\\)?\\'")
- "Value for `tramp-completion-file-name-regexp' for default remoting.
-See `tramp-file-name-structure' for more explanations.
-
-On W32 systems, the volume letter must be ignored.")
-
-(defconst tramp-completion-file-name-regexp-simplified
- (concat
- "\\`"
- ;; Allow the volume letter at the beginning of the path. See the
- ;; comment in `tramp-completion-file-name-regexp-default' for more
- ;; details.
- (when (eq system-type 'windows-nt)
- "\\(?:[[:alpha:]]:\\)?")
- "/\\("
- ;; Optional multi hop.
- "\\([^/|:]*|\\)*"
- ;; Last hop.
- (if (memq system-type '(cygwin windows-nt))
- ;; At least two characters.
- "[^/|:]\\{2,\\}"
- ;; At least one character.
- "[^/|:]+")
- "\\)?\\'")
- "Value for `tramp-completion-file-name-regexp' for simplified style remoting.
-See `tramp-file-name-structure' for more explanations.
-
-On W32 systems, the volume letter must be ignored.")
-
-(defconst tramp-completion-file-name-regexp-separate
- (concat
- "\\`"
- ;; Allow the volume letter at the beginning of the path. See the
- ;; comment in `tramp-completion-file-name-regexp-default' for more
- ;; details.
- (when (eq system-type 'windows-nt)
- "\\(?:[[:alpha:]]:\\)?")
- "/\\(\\[[^]]*\\)?\\'")
- "Value for `tramp-completion-file-name-regexp' for separate remoting.
-See `tramp-file-name-structure' for more explanations.")
-
-(defconst tramp-completion-file-name-regexp-alist
- `((default . ,tramp-completion-file-name-regexp-default)
- (simplified . ,tramp-completion-file-name-regexp-simplified)
- (separate . ,tramp-completion-file-name-regexp-separate))
- "Alist mapping incomplete Tramp file names.")
+(defconst tramp-volume-letter-regexp
+ (if (eq system-type 'windows-nt)
+ (rx bos alpha ":") "")
+ "Volume letter on MS Windows.")
+
+;; `tramp-method-regexp' needs at least two characters, in order to
+;; distinguish from volume letter. This is in the way when completing.
+(defconst tramp-completion-method-regexp-alist
+ `((default . ,(tramp-compat-rx
+ (| (literal tramp-default-method-marker) (+ alnum))))
+ (simplified . "")
+ (separate . ,(tramp-compat-rx
+ (| (literal tramp-default-method-marker) (* alnum)))))
+ "Alist mapping Tramp syntax to regexps matching completion methods.")
+
+(defun tramp-build-completion-method-regexp ()
+ "Return `tramp-completion-method-regexp' according to `tramp-syntax'."
+ (tramp-lookup-syntax tramp-completion-method-regexp-alist))
+
+(defvar tramp-completion-method-regexp
+ nil ; Initialized when defining `tramp-syntax'!
+ "Regexp matching completion method identifiers.
+The `ftp' syntax does not support methods.")
(defun tramp-build-completion-file-name-regexp ()
"Return `tramp-completion-file-name-regexp' according to `tramp-syntax'."
- (tramp-lookup-syntax tramp-completion-file-name-regexp-alist))
+ (if (eq tramp-syntax 'separate)
+ ;; FIXME: This shouldn't be necessary.
+ (tramp-compat-rx bos "/" (? "[" (* (not "]"))) eos)
+ (tramp-compat-rx
+ bos
+ ;; `file-name-completion' uses absolute paths for matching.
+ ;; This means that on W32 systems, something like
+ ;; "/ssh:host:~/path" becomes "c:/ssh:host:~/path". See also
+ ;; `tramp-drop-volume-letter'.
+ (? (regexp tramp-volume-letter-regexp))
+ ;; We cannot use `tramp-prefix-regexp', because it starts with `bol'.
+ (literal tramp-prefix-format)
+
+ ;; Optional multi hops.
+ (* (regexp tramp-remote-file-name-spec-regexp)
+ (regexp tramp-postfix-hop-regexp))
+
+ ;; Last hop.
+ (? (regexp tramp-completion-method-regexp)
+ ;; Method separator, user name and host name.
+ (? (regexp tramp-postfix-method-regexp)
+ ;; This is a little bit lax, but it serves.
+ (? (regexp tramp-host-regexp))))
+
+ eos)))
(defvar tramp-completion-file-name-regexp
- nil ;Initialized when defining `tramp-syntax'!
+ nil ; Initialized when defining `tramp-syntax'!
"Regular expression matching file names handled by Tramp completion.
This regexp should match partial Tramp file names only.
@@ -1194,14 +1236,8 @@ Also see `tramp-file-name-structure'.")
;;;###autoload
(defconst tramp-autoload-file-name-regexp
- (concat
- "\\`/"
- (if (memq system-type '(cygwin windows-nt))
- ;; The method is either "-", or at least two characters.
- "\\(-\\|[^/|:]\\{2,\\}\\)"
- ;; At least one character for method.
- "[^/|:]+")
- ":")
+ ;; The method is either "-", or at least two characters.
+ (rx bos "/" (| "-" (>= 2 (not (any "/:|")))) ":")
"Regular expression matching file names handled by Tramp autoload.
It must match the initial `tramp-syntax' settings. It should not
match file names at root of the underlying local file system,
@@ -1377,7 +1413,8 @@ would require an immediate reread during filename
completion, nil
means to use always cached values for the directory contents."
:type '(choice (const nil) (const t) integer))
(make-obsolete-variable
- 'tramp-completion-reread-directory-timeout 'remote-file-name-inhibit-cache
"27.2")
+ 'tramp-completion-reread-directory-timeout
+ 'remote-file-name-inhibit-cache "27.2")
;;; Internal Variables:
@@ -1392,6 +1429,11 @@ Will be called once the password has been verified by
successful
authentication.")
(put 'tramp-password-save-function 'tramp-suppress-trace t)
+(defvar tramp-password-prompt-not-unique nil
+ "Whether several passwords might be requested.
+This shouldn't be set explicitly. It is let-bound, for example
+during direct remote copying with scp.")
+
(defconst tramp-completion-file-name-handler-alist
'((file-name-all-completions
. tramp-completion-handle-file-name-all-completions)
@@ -1402,6 +1444,7 @@ Operations not mentioned here will be handled by Tramp's
file
name handler functions, or the normal Emacs functions.")
;; Handlers for foreign methods, like FTP or SMB, shall be plugged here.
+;;;###autoload
(defvar tramp-foreign-file-name-handler-alist nil
"Alist of elements (FUNCTION . HANDLER) for foreign methods handled
specially.
If (FUNCTION FILENAME) returns non-nil, then all I/O on that file is done by
@@ -1413,13 +1456,19 @@ calling HANDLER.")
;; internal data structure. Convenience functions for internal
;; data structure.
-;; The basic structure for remote file names. We use a list :type, in
-;; order to be compatible with Emacs 25. We must autoload it in
-;; tramp-loaddefs.el, because some functions, which need it, wouldn't
-;; work otherwise when unloading / reloading Tramp. (Bug#50869)
+;; The basic structure for remote file names.
+
+;; Note: We started autoloading it in tramp-loaddefs.el, because some
+;; functions, which needed it, wouldn't work otherwise when unloading
+;; / reloading Tramp (Bug#50869).
+;; This bug is fixed in Emacs 29, but other parts of Tramp have grown
+;; dependencies on having this in tramp-loaddefs.el in the mean time,
+;; so .... here we are.
+;;;###tramp-autoload(require 'cl-lib)
;;;###tramp-autoload
-(cl-defstruct (tramp-file-name (:type list) :named)
- method user domain host port localname hop)
+(progn
+ (cl-defstruct (tramp-file-name (:type list) :named)
+ method user domain host port localname hop))
(put #'tramp-file-name-method 'tramp-suppress-trace t)
(put #'tramp-file-name-user 'tramp-suppress-trace t)
@@ -1429,6 +1478,11 @@ calling HANDLER.")
(put #'tramp-file-name-localname 'tramp-suppress-trace t)
(put #'tramp-file-name-hop 'tramp-suppress-trace t)
+;; Needed for `tramp-read-passwd' and `tramp-get-remote-null-device'.
+(defconst tramp-null-hop
+ (make-tramp-file-name :user (user-login-name) :host tramp-system-name)
+"Connection hop which identifies the virtual hop before the first one.")
+
(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))
@@ -1457,21 +1511,31 @@ If nil, return `tramp-default-port'."
(put #'tramp-file-name-port-or-default 'tramp-suppress-trace t)
-(defun tramp-file-name-unify (vec)
+;;;###tramp-autoload
+(defun tramp-file-name-unify (vec &optional localname)
"Unify VEC by removing localname and hop from `tramp-file-name' structure.
+If LOCALNAME is an absolute file name, set it as localname. If
+LOCALNAME is a relative file name, return `tramp-cache-undefined'.
Objects returned by this function compare `equal' if they refer to the
same connection. Make a copy in order to avoid side effects."
- (when (tramp-file-name-p vec)
- (setq vec (copy-tramp-file-name vec))
- (setf (tramp-file-name-localname vec) nil
- (tramp-file-name-hop vec) nil))
- vec)
+ (if (and (stringp localname)
+ (not (file-name-absolute-p localname)))
+ (setq vec tramp-cache-undefined)
+ (when (tramp-file-name-p vec)
+ (setq vec (copy-tramp-file-name vec))
+ (setf (tramp-file-name-localname vec)
+ (and (stringp localname)
+ (tramp-compat-file-name-unquote
+ (directory-file-name localname)))
+ (tramp-file-name-hop vec) nil))
+ vec))
(put #'tramp-file-name-unify 'tramp-suppress-trace t)
;; Comparison of file names is performed by `tramp-equal-remote'.
(defun tramp-file-name-equal-p (vec1 vec2)
- "Check, whether VEC1 and VEC2 denote the same `tramp-file-name'."
+ "Check, whether VEC1 and VEC2 denote the same `tramp-file-name'.
+LOCALNAME and HOP do not count."
(and (tramp-file-name-p vec1) (tramp-file-name-p vec2)
(equal (tramp-file-name-unify vec1)
(tramp-file-name-unify vec2))))
@@ -1482,10 +1546,10 @@ If VEC is a vector, check first in connection
properties.
Afterwards, check in `tramp-methods'. If the `tramp-methods'
entry does not exist, return nil."
(let ((hash-entry
- (replace-regexp-in-string "^tramp-" "" (symbol-name param))))
+ (replace-regexp-in-string (rx bos "tramp-") "" (symbol-name param))))
(if (tramp-connection-property-p vec hash-entry)
;; We use the cached property.
- (tramp-get-connection-property vec hash-entry nil)
+ (tramp-get-connection-property vec hash-entry)
;; Use the static value from `tramp-methods'.
(when-let ((methods-entry
(assoc
@@ -1497,14 +1561,12 @@ entry does not exist, return nil."
"Return unquoted localname component of VEC."
(tramp-compat-file-name-unquote (tramp-file-name-localname vec)))
+;;;###tramp-autoload
(defun tramp-tramp-file-p (name)
"Return t if NAME is a string with Tramp file name syntax."
(and tramp-mode (stringp name)
;; No "/:" and "/c:". This is not covered by `tramp-file-name-regexp'.
- (not (string-match-p
- (if (memq system-type '(cygwin windows-nt))
- "^/[[:alpha:]]?:" "^/:")
- name))
+ (not (string-match-p (rx bos "/" (? alpha) ":") name))
;; Excluded file names.
(or (null tramp-ignored-file-name-regexp)
(not (string-match-p tramp-ignored-file-name-regexp name)))
@@ -1518,6 +1580,7 @@ entry does not exist, return nil."
;; However, it is more performant than `file-local-name', and might be
;; useful where performance matters, like in operations over a bulk
;; list of file names.
+;;;###tramp-autoload
(defun tramp-file-local-name (name)
"Return the local name component of NAME.
This function removes from NAME the specification of the remote
@@ -1529,7 +1592,7 @@ of `process-file', `start-file-process', or
`shell-command'."
(or (and (tramp-tramp-file-p name)
(string-match (nth 0 tramp-file-name-structure) name)
(match-string (nth 4 tramp-file-name-structure) name))
- (tramp-compat-file-local-name name)))
+ (file-local-name name)))
;; The localname can be quoted with "/:". Extract this.
(defun tramp-unquote-file-local-name (name)
@@ -1541,7 +1604,7 @@ of `process-file', `start-file-process', or
`shell-command'."
This is METHOD, if non-nil. Otherwise, do a lookup in
`tramp-default-method-alist' and `tramp-default-method'."
(when (and method
- (or (string-equal method "")
+ (or (string-empty-p method)
(string-equal method tramp-default-method-marker)))
(setq method nil))
(let ((result
@@ -1609,6 +1672,7 @@ This is HOST, if non-nil. Otherwise, do a lookup in
(put #'tramp-find-host 'tramp-suppress-trace t)
+;;;###tramp-autoload
(defun tramp-dissect-file-name (name &optional nodefault)
"Return a `tramp-file-name' structure of NAME, a remote file name.
The structure consists of method, user, domain, host, port,
@@ -1676,13 +1740,26 @@ default values are used."
(put #'tramp-dissect-file-name 'tramp-suppress-trace t)
+;;;###tramp-autoload
+(defun tramp-ensure-dissected-file-name (vec-or-filename)
+ "Return a `tramp-file-name' structure for VEC-OR-FILENAME.
+
+VEC-OR-FILENAME may be either a string or a `tramp-file-name'.
+If it's not a Tramp filename, return nil."
+ (cond
+ ((tramp-file-name-p vec-or-filename) vec-or-filename)
+ ((tramp-tramp-file-p vec-or-filename)
+ (tramp-dissect-file-name vec-or-filename))))
+
+(put #'tramp-ensure-dissected-file-name 'tramp-suppress-trace t)
+
(defun tramp-dissect-hop-name (name &optional nodefault)
"Return a `tramp-file-name' structure of `hop' part of NAME.
See `tramp-dissect-file-name' for details."
(let ((v (tramp-dissect-file-name
(concat tramp-prefix-format
(replace-regexp-in-string
- (concat tramp-postfix-hop-regexp "$")
+ (tramp-compat-rx (regexp tramp-postfix-hop-regexp) eos)
tramp-postfix-host-format name))
nodefault)))
;; Only some methods from tramp-sh.el do support multi-hops.
@@ -1706,17 +1783,15 @@ See `tramp-dissect-file-name' for details."
(put #'tramp-buffer-name 'tramp-suppress-trace t)
+;;;###tramp-autoload
(defun tramp-make-tramp-file-name (&rest args)
"Construct a Tramp file name from ARGS.
ARGS could have two different signatures. The first one is of
-type (VEC &optional LOCALNAME HOP).
+type (VEC &optional LOCALNAME).
If LOCALNAME is nil, the value in VEC is used. If it is a
symbol, a null localname will be used. Otherwise, LOCALNAME is
expected to be a string, which will be used.
-If HOP is nil, the value in VEC is used. If it is a symbol, a
-null hop will be used. Otherwise, HOP is expected to be a
-string, which will be used.
The other signature exists for backward compatibility. It has
the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)."
@@ -1732,8 +1807,13 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME
&optional HOP)."
hop (tramp-file-name-hop (car args)))
(when (cadr args)
(setq localname (and (stringp (cadr args)) (cadr args))))
- (when (cl-caddr args)
- (setq hop (and (stringp (cl-caddr args)) (cl-caddr args)))))
+ (when hop
+ (setq hop nil)
+ ;; Assure that the hops are in `tramp-default-proxies-alist'.
+ ;; In tramp-archive.el, the slot `hop' is used for the archive
+ ;; file name.
+ (unless (string-equal method tramp-archive-method)
+ (tramp-add-hops (car args)))))
(t (setq method (nth 0 args)
user (nth 1 args)
@@ -1766,15 +1846,19 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME
&optional HOP)."
localname)))
(set-advertised-calling-convention
- #'tramp-make-tramp-file-name '(vec &optional localname hop) "27.1")
+ #'tramp-make-tramp-file-name '(vec &optional localname) "29.1")
(defun tramp-make-tramp-hop-name (vec)
"Construct a Tramp hop name from VEC."
- (replace-regexp-in-string
- tramp-prefix-regexp ""
+ (concat
+ (tramp-file-name-hop vec)
(replace-regexp-in-string
- (concat tramp-postfix-host-regexp "$") tramp-postfix-hop-format
- (tramp-make-tramp-file-name vec 'noloc))))
+ tramp-prefix-regexp ""
+ (replace-regexp-in-string
+ (tramp-compat-rx
+ (regexp tramp-postfix-host-regexp) eos)
+ tramp-postfix-hop-format
+ (tramp-make-tramp-file-name vec 'noloc)))))
(defun tramp-completion-make-tramp-file-name (method user host localname)
"Construct a Tramp file name from METHOD, USER, HOST and LOCALNAME.
@@ -1805,25 +1889,26 @@ Unless DONT-CREATE, the buffer is created when it
doesn't exist yet."
;; as indication, whether a connection is active.
(tramp-set-connection-property
vec "process-buffer"
- (tramp-get-connection-property vec "process-buffer" nil))
+ (tramp-get-connection-property vec "process-buffer"))
(setq buffer-undo-list t
default-directory
- (tramp-make-tramp-file-name vec 'noloc 'nohop))
+ (tramp-make-tramp-file-name vec 'noloc))
(current-buffer)))))
+;;;###tramp-autoload
(defun tramp-get-connection-buffer (vec &optional dont-create)
"Get the connection buffer to be used for VEC.
Unless DONT-CREATE, the buffer is created when it doesn't exist yet.
In case a second asynchronous communication has been started, it is different
from `tramp-get-buffer'."
- (or (tramp-get-connection-property vec "process-buffer" nil)
+ (or (tramp-get-connection-property vec "process-buffer")
(tramp-get-buffer vec dont-create)))
(defun tramp-get-connection-name (vec)
"Get the connection name to be used for VEC.
In case a second asynchronous communication has been started, it is different
from the default one."
- (or (tramp-get-connection-property vec "process-name" nil)
+ (or (tramp-get-connection-property vec "process-name")
(tramp-buffer-name vec)))
(defun tramp-get-process (vec-or-proc)
@@ -1846,9 +1931,7 @@ from the default one."
If connection-local variables are not supported by this Emacs
version, the function does nothing."
(with-current-buffer (tramp-get-connection-buffer vec)
- ;; `hack-connection-local-variables-apply' exists since Emacs 26.1.
- (tramp-compat-funcall
- 'hack-connection-local-variables-apply
+ (hack-connection-local-variables-apply
`(:application tramp
:protocol ,(tramp-file-name-method vec)
:user ,(tramp-file-name-user-domain vec)
@@ -1859,14 +1942,24 @@ version, the function does nothing."
If connection-local variables are not supported by this Emacs
version, the function does nothing."
(when (tramp-tramp-file-p default-directory)
- ;; `hack-connection-local-variables-apply' exists since Emacs 26.1.
- (tramp-compat-funcall
- 'hack-connection-local-variables-apply
+ (hack-connection-local-variables-apply
`(:application tramp
:protocol ,(file-remote-p default-directory 'method)
:user ,(file-remote-p default-directory 'user)
:machine ,(file-remote-p default-directory 'host)))))
+(defsubst tramp-get-default-directory (buffer)
+ "Return `default-directory' of BUFFER."
+ (buffer-local-value 'default-directory buffer))
+
+;;;###tramp-autoload
+(defsubst tramp-get-buffer-string (&optional buffer)
+ "Return contents of BUFFER.
+If BUFFER is not a buffer or a buffer name, return the contents
+of `current-buffer'."
+ (with-current-buffer (or buffer (current-buffer))
+ (substring-no-properties (buffer-string))))
+
(defun tramp-debug-buffer-name (vec)
"A name for the debug buffer for VEC."
(let ((method (tramp-file-name-method vec))
@@ -1879,10 +1972,12 @@ version, the function does nothing."
(put #'tramp-debug-buffer-name 'tramp-suppress-trace t)
(defconst tramp-debug-outline-regexp
- (concat
- "[[:digit:]]+:[[:digit:]]+:[[:digit:]]+\\.[[:digit:]]+ " ;; Timestamp.
- "\\(?:\\(#<thread .+>\\) \\)?" ;; Thread.
- "[[:alnum:]-]+ (\\([[:digit:]]+\\)) #") ;; Function name, verbosity.
+ (rx ;; Timestamp.
+ (+ digit) ":" (+ digit) ":" (+ digit) "." (+ digit) blank
+ ;; Thread.
+ (? (group "#<thread " (+ nonl) ">") blank)
+ ;; Function name, verbosity.
+ (+ (any "-" alnum)) " (" (group (+ digit)) ") #")
"Used for highlighting Tramp debug buffers in `outline-mode'.")
(defconst tramp-debug-font-lock-keywords
@@ -1891,7 +1986,7 @@ version, the function does nothing."
;; Also, in `font-lock-defaults' you can specify a function name for
;; the "KEYWORDS" part, so font-lock calls it to get the actual keywords!
'(list
- (concat "^\\(?:" tramp-debug-outline-regexp "\\).+")
+ (tramp-compat-rx bol (regexp tramp-debug-outline-regexp) (+ nonl))
'(1 font-lock-warning-face t t)
'(0 (outline-font-lock-face) keep t))
"Used for highlighting Tramp debug buffers in `outline-mode'.")
@@ -1905,29 +2000,58 @@ The outline level is equal to the verbosity of the
Tramp message."
(put #'tramp-debug-outline-level 'tramp-suppress-trace t)
+;; This function takes action since Emacs 28.1, when
+;; `read-extended-command-predicate' is set to
+;; `command-completion-default-include-p'.
+(defun tramp-debug-buffer-command-completion-p (_symbol buffer)
+ "A predicate for Tramp interactive commands.
+They are completed by \"M-x TAB\" only in Tramp debug buffers."
+ (with-current-buffer buffer
+ (string-equal
+ (buffer-substring (point-min) (min (+ (point-min) 10) (point-max)))
+ ";; Emacs:")))
+
+(put #'tramp-debug-buffer-command-completion-p 'tramp-suppress-trace t)
+
+(defun tramp-setup-debug-buffer ()
+ "Function to setup debug buffers."
+ ;; (declare (completion tramp-debug-buffer-command-completion-p))
+ (interactive)
+ (set-buffer-file-coding-system 'utf-8)
+ (setq buffer-undo-list t)
+ ;; Activate `outline-mode'. This runs `text-mode-hook' and
+ ;; `outline-mode-hook'. We must prevent that local processes die.
+ ;; Yes: I've seen `flyspell-mode', which starts "ispell".
+ ;; `(custom-declare-variable outline-minor-mode-prefix ...)' raises
+ ;; on error in `(outline-mode)', we don't want to see it in the
+ ;; traces.
+ (let ((default-directory tramp-compat-temporary-file-directory))
+ (outline-mode))
+ (setq-local outline-level 'tramp-debug-outline-level)
+ (setq-local font-lock-keywords
+ ;; FIXME: This `(t FOO . BAR)' representation in
+ ;; `font-lock-keywords' is supposed to be an internal
+ ;; implementation "detail". Don't abuse it here!
+ `(t (eval ,tramp-debug-font-lock-keywords t)
+ ,(eval tramp-debug-font-lock-keywords t)))
+ ;; Do not edit the debug buffer.
+ (use-local-map special-mode-map)
+ (set-buffer-modified-p nil)
+ ;; For debugging purposes.
+ (local-set-key "\M-n" 'clone-buffer)
+ (add-hook 'clone-buffer-hook #'tramp-setup-debug-buffer nil 'local))
+
+(put #'tramp-setup-debug-buffer 'tramp-suppress-trace t)
+
+(function-put
+ #'tramp-setup-debug-buffer 'completion-predicate
+ #'tramp-debug-buffer-command-completion-p)
+
(defun tramp-get-debug-buffer (vec)
"Get the debug buffer for VEC."
(with-current-buffer (get-buffer-create (tramp-debug-buffer-name vec))
(when (bobp)
- (set-buffer-file-coding-system 'utf-8)
- (setq buffer-undo-list t)
- ;; Activate `outline-mode'. This runs `text-mode-hook' and
- ;; `outline-mode-hook'. We must prevent that local processes
- ;; die. Yes: I've seen `flyspell-mode', which starts "ispell".
- ;; `(custom-declare-variable outline-minor-mode-prefix ...)'
- ;; raises on error in `(outline-mode)', we don't want to see it
- ;; in the traces.
- (let ((default-directory tramp-compat-temporary-file-directory))
- (outline-mode))
- (setq-local outline-level 'tramp-debug-outline-level)
- (setq-local font-lock-keywords
- ;; FIXME: This `(t FOO . BAR)' representation in
- ;; `font-lock-keywords' is supposed to be an
- ;; internal implementation "detail". Don't abuse it here!
- `(t (eval ,tramp-debug-font-lock-keywords t)
- ,(eval tramp-debug-font-lock-keywords t)))
- ;; Do not edit the debug buffer.
- (use-local-map special-mode-map))
+ (tramp-setup-debug-buffer))
(current-buffer)))
(put #'tramp-get-debug-buffer 'tramp-suppress-trace t)
@@ -1949,6 +2073,7 @@ The outline level is equal to the verbosity of the Tramp
message."
(defvar tramp-trace-functions nil
"A list of non-Tramp functions to be traced with `tramp-verbose' > 10.")
+;;;###tramp-autoload
(defun tramp-debug-message (vec fmt-string &rest arguments)
"Append message to debug buffer of VEC.
Message is formatted with FMT-STRING as control string and the remaining
@@ -1989,9 +2114,7 @@ ARGUMENTS to actually emit the message (if applicable)."
(unless (bolp)
(insert "\n"))
;; Timestamp.
- (let ((now (current-time)))
- (insert (format-time-string "%T." now))
- (insert (format "%06d " (nth 2 now))))
+ (insert (format-time-string "%T.%6N "))
;; Calling Tramp function. We suppress compat and trace
;; functions from being displayed.
(let ((btn 1) btf fn)
@@ -2024,10 +2147,12 @@ ARGUMENTS to actually emit the message (if applicable)."
(put #'tramp-debug-message 'tramp-suppress-trace t)
+;;;###tramp-autoload
(defvar tramp-inhibit-progress-reporter nil
"Show Tramp progress reporter in the minibuffer.
This variable is used to disable concurrent progress reporter messages.")
+;;;###tramp-autoload
(defsubst tramp-message (vec-or-proc level fmt-string &rest arguments)
"Emit a message depending on verbosity level.
VEC-OR-PROC identifies the Tramp buffer to use. It can be either a
@@ -2061,12 +2186,15 @@ applicable)."
;; Append connection buffer for error messages, if exists.
(when (= level 1)
(ignore-errors
- (with-current-buffer
- (if (processp vec-or-proc)
- (process-buffer vec-or-proc)
- (tramp-get-connection-buffer vec-or-proc 'dont-create))
- (setq fmt-string (concat fmt-string "\n%s")
- arguments (append arguments (list (buffer-string)))))))
+ (setq fmt-string (concat fmt-string "\n%s")
+ arguments
+ (append
+ arguments
+ `(,(tramp-get-buffer-string
+ (if (processp vec-or-proc)
+ (process-buffer vec-or-proc)
+ (tramp-get-connection-buffer
+ vec-or-proc 'dont-create))))))))
;; Translate proc to vec.
(when (processp vec-or-proc)
(setq vec-or-proc (process-get vec-or-proc 'vector))))
@@ -2077,19 +2205,17 @@ applicable)."
(concat (format "(%d) # " level) fmt-string)
arguments))))))
-(put #'tramp-message 'tramp-suppress-trace t)
-
-(defsubst tramp-backtrace (&optional vec-or-proc)
+(defsubst tramp-backtrace (&optional vec-or-proc force)
"Dump a backtrace into the debug buffer.
-If VEC-OR-PROC is nil, the buffer *debug tramp* is used. This
-function is meant for debugging purposes."
- (when (>= tramp-verbose 10)
- (if vec-or-proc
- (tramp-message
- vec-or-proc 10 "\n%s" (with-output-to-string (backtrace)))
- (with-output-to-temp-buffer "*debug tramp*" (backtrace)))))
-
-(put #'tramp-backtrace 'tramp-suppress-trace t)
+If VEC-OR-PROC is nil, the buffer *debug tramp* is used. FORCE
+forces the backtrace even if `tramp-verbose' is less than 10.
+This function is meant for debugging purposes."
+ (let ((tramp-verbose (if force 10 tramp-verbose)))
+ (when (>= tramp-verbose 10)
+ (if vec-or-proc
+ (tramp-message
+ vec-or-proc 10 "\n%s" (with-output-to-string (backtrace)))
+ (with-output-to-temp-buffer "*debug tramp*" (backtrace))))))
(defun tramp-error (vec-or-proc signal fmt-string &rest arguments)
"Emit an error.
@@ -2117,6 +2243,11 @@ FMT-STRING and ARGUMENTS."
(put #'tramp-error 'tramp-suppress-trace t)
+(defvar tramp-error-show-message-timeout 30
+ "Time to show the Tramp buffer in case of an error.
+If it is bound to nil, the buffer is not shown. This is used in
+tramp-tests.el.")
+
(defsubst tramp-error-with-buffer
(buf vec-or-proc signal fmt-string &rest arguments)
"Emit an error, and show BUF.
@@ -2128,12 +2259,13 @@ an input event arrives. The other arguments are passed
to `tramp-error'."
(and (tramp-file-name-p vec-or-proc)
(tramp-get-connection-buffer 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))))))
+ (and buf (tramp-dissect-file-name
+ (tramp-get-default-directory buf))))))
(unwind-protect
(apply #'tramp-error vec-or-proc signal fmt-string arguments)
;; Save exit.
(when (and buf
+ (natnump tramp-error-show-message-timeout)
(not (zerop tramp-verbose))
;; Do not show when flagged from outside.
(not non-essential)
@@ -2147,20 +2279,19 @@ an input event arrives. The other arguments are passed
to `tramp-error'."
;; Show buffer.
(pop-to-buffer buf)
(discard-input)
- (sit-for 30)))
+ (sit-for tramp-error-show-message-timeout)))
;; Reset timestamp. It would be wrong after waiting for a while.
(when (tramp-file-name-equal-p vec (car tramp-current-connection))
(setcdr tramp-current-connection (current-time)))))))
-(put #'tramp-error-with-buffer 'tramp-suppress-trace t)
-
;; We must make it a defun, because it is used earlier already.
(defun tramp-user-error (vec-or-proc fmt-string &rest arguments)
"Signal a user error (or \"pilot error\")."
(unwind-protect
(apply #'tramp-error vec-or-proc 'user-error fmt-string arguments)
;; Save exit.
- (when (and (not (zerop tramp-verbose))
+ (when (and (natnump tramp-error-show-message-timeout)
+ (not (zerop tramp-verbose))
;; Do not show when flagged from outside.
(not non-essential)
;; Show only when Emacs has started already.
@@ -2170,7 +2301,7 @@ an input event arrives. The other arguments are passed
to `tramp-error'."
;; `tramp-error' does not show messages. So we must do it ourselves.
(apply #'message fmt-string arguments)
(discard-input)
- (sit-for 30)
+ (sit-for tramp-error-show-message-timeout)
;; Reset timestamp. It would be wrong after waiting for a while.
(when
(tramp-file-name-equal-p vec-or-proc (car tramp-current-connection))
@@ -2189,7 +2320,21 @@ the resulting error message."
(progn ,@body)
(error (tramp-message ,vec-or-proc 3 ,format ,err) nil))))
-(put #'tramp-with-demoted-errors 'tramp-suppress-trace t)
+;; This macro shall optimize the cases where an `file-exists-p' call
+;; is invoked first. Often, the file exists, so the remote command is
+;; superfluous.
+(defmacro tramp-barf-if-file-missing (vec filename &rest body)
+ "Execute BODY and return the result.
+In case if an error, raise a `file-missing' error if FILENAME
+does not exist, otherwise propagate the error."
+ (declare (indent 2) (debug (symbolp form body)))
+ (let ((err (make-symbol "err")))
+ `(condition-case ,err
+ (progn ,@body)
+ (error
+ (if (not (file-exists-p ,filename))
+ (tramp-error ,vec 'file-missing ,filename)
+ (signal (car ,err) (cdr ,err)))))))
(defun tramp-test-message (fmt-string &rest arguments)
"Emit a Tramp message according `default-directory'."
@@ -2250,8 +2395,6 @@ If VAR is nil, then we bind `v' to the structure and
`method', `user',
(ignore ,@(mapcar #'car bindings))
,@body)))
-(font-lock-add-keywords 'emacs-lisp-mode
'("\\<with-parsed-tramp-file-name\\>"))
-
(defun tramp-progress-reporter-update (reporter &optional value suffix)
"Report progress of an operation for Tramp."
(let* ((parameters (cdr reporter))
@@ -2274,7 +2417,7 @@ without a visible progress reporter."
;; running, and when there is a minimum level.
(when-let ((pr (and (null tramp-inhibit-progress-reporter)
(<= ,level (min tramp-verbose 3))
- (make-progress-reporter ,message nil nil))))
+ (make-progress-reporter ,message))))
(run-at-time 3 0.1 #'tramp-progress-reporter-update pr))))
(unwind-protect
;; Execute the body.
@@ -2288,43 +2431,6 @@ without a visible progress reporter."
(if tm (cancel-timer tm))
(tramp-message ,vec ,level "%s...%s" ,message cookie)))))
-(font-lock-add-keywords
- 'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>"))
-
-(defmacro with-tramp-file-property (vec file property &rest body)
- "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache.
-FILE must be a local file name on a connection identified via VEC."
- (declare (indent 3) (debug t))
- `(if (file-name-absolute-p ,file)
- (let ((value (tramp-get-file-property
- ,vec ,file ,property tramp-cache-undefined)))
- (when (eq value tramp-cache-undefined)
- ;; We cannot pass @body as parameter to
- ;; `tramp-set-file-property' because it mangles our debug
- ;; messages.
- (setq value (progn ,@body))
- (tramp-set-file-property ,vec ,file ,property value))
- value)
- ,@body))
-
-(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-file-property\\>"))
-
-(defmacro with-tramp-connection-property (key property &rest body)
- "Check in Tramp for property PROPERTY, otherwise execute BODY and set."
- (declare (indent 2) (debug t))
- `(let ((value (tramp-get-connection-property
- ,key ,property tramp-cache-undefined)))
- (when (eq value tramp-cache-undefined)
- ;; We cannot pass ,@body as parameter to
- ;; `tramp-set-connection-property' because it mangles our debug
- ;; messages.
- (setq value (progn ,@body))
- (tramp-set-connection-property ,key ,property value))
- value))
-
-(font-lock-add-keywords
- 'emacs-lisp-mode '("\\<with-tramp-connection-property\\>"))
-
(defun tramp-drop-volume-letter (name)
"Cut off unnecessary drive letter from file NAME.
The functions `tramp-*-handle-expand-file-name' call `expand-file-name'
@@ -2334,15 +2440,19 @@ letter into the file name. This function removes it."
(save-match-data
(let ((quoted (tramp-compat-file-name-quoted-p name 'top))
(result (tramp-compat-file-name-unquote name 'top)))
- (setq result (if (string-match "\\`[[:alpha:]]:/" result)
- (replace-match "/" nil t result) result))
+ (setq result
+ (replace-regexp-in-string
+ (tramp-compat-rx (regexp tramp-volume-letter-regexp) "/")
+ "/" result))
(if quoted (tramp-compat-file-name-quote result 'top) result))))
;;; Config Manipulation Functions:
-(defconst tramp-dns-sd-service-regexp "^_[-[:alnum:]]+\\._tcp$"
+(defconst tramp-dns-sd-service-regexp
+ (rx bol "_" (+ (any "-" alnum)) "._tcp" eol)
"DNS-SD service regexp.")
+;;;###tramp-autoload
(defun tramp-set-completion-function (method function-list)
"Set the list of completion functions for METHOD.
FUNCTION-LIST is a list of entries of the form (FUNCTION FILE).
@@ -2418,7 +2528,7 @@ For definition of that list see
`tramp-set-completion-function'."
(defun tramp-default-file-modes (filename &optional flag)
"Return file modes of FILENAME as integer.
-If optional FLAG is ‘nofollow’, do not follow FILENAME if it is a
+If optional FLAG is `nofollow', do not follow FILENAME if it is a
symbolic link. If the file modes of FILENAME cannot be
determined, return the value of `default-file-modes', without
execute permissions."
@@ -2442,7 +2552,7 @@ coding system might not be determined. This function
repairs it."
;; We found a matching entry in `file-coding-system-alist'.
;; So we add a similar entry, but with the temporary file name
;; as regexp.
- (push (cons (regexp-quote tmpname) (cdr elt)) result)))))
+ (push (cons (tramp-compat-rx (literal tmpname)) (cdr elt)) result)))))
(defun tramp-run-real-handler (operation args)
"Invoke normal file name handler for OPERATION.
@@ -2460,6 +2570,7 @@ arguments to pass to the OPERATION."
,(and (eq inhibit-file-name-operation operation)
inhibit-file-name-handlers)))
(inhibit-file-name-operation operation)
+ (args (if (tramp-file-name-p (car args)) (cons nil (cdr args)) args))
signal-hook-function)
(apply operation args)))
@@ -2487,21 +2598,21 @@ Must be handled by the callers."
file-accessible-directory-p file-attributes
file-directory-p file-executable-p file-exists-p
file-local-copy file-modes file-name-as-directory
- file-name-directory file-name-nondirectory
- file-name-sans-versions file-notify-add-watch
- file-ownership-preserved-p file-readable-p
- file-regular-p file-remote-p file-selinux-context
- file-symlink-p file-truename file-writable-p
- find-backup-file-name get-file-buffer
+ file-name-case-insensitive-p file-name-directory
+ file-name-nondirectory file-name-sans-versions
+ file-notify-add-watch file-ownership-preserved-p
+ file-readable-p file-regular-p file-remote-p
+ file-selinux-context file-symlink-p file-truename
+ file-writable-p find-backup-file-name get-file-buffer
insert-directory insert-file-contents load
- make-directory make-directory-internal set-file-acl
- set-file-modes set-file-selinux-context set-file-times
+ make-directory set-file-acl set-file-modes
+ set-file-selinux-context set-file-times
substitute-in-file-name unhandled-file-name-directory
vc-registered
- ;; Emacs 26+ only.
- file-name-case-insensitive-p
;; Emacs 27+ only.
file-system-info
+ ;; Emacs 28- only.
+ make-directory-internal
;; Emacs 28+ only.
file-locked-p lock-file make-lock-file-name unlock-file
;; Emacs 29+ only.
@@ -2512,8 +2623,6 @@ Must be handled by the callers."
(nth 0 args)
default-directory))
;; STRING FILE.
- ;; Starting with Emacs 26.1, just the 2nd argument of
- ;; `make-symbolic-link' matters.
((eq operation 'make-symbolic-link) (nth 1 args))
;; FILE DIRECTORY resp FILE1 FILE2.
((member operation
@@ -2544,37 +2653,49 @@ Must be handled by the callers."
(if (bufferp (nth 0 args)) (nth 0 args) (current-buffer))))
;; COMMAND.
((member operation
- '(process-file shell-command start-file-process
- ;; Emacs 26+ only.
- make-nearby-temp-file temporary-file-directory
+ '(make-nearby-temp-file process-file shell-command
+ start-file-process temporary-file-directory
;; Emacs 27+ only.
- exec-path make-process))
+ exec-path make-process
+ ;; Emacs 29+ only.
+ list-system-processes memory-info process-attributes))
default-directory)
;; PROC.
((member operation '(file-notify-rm-watch file-notify-valid-p))
(when (processp (nth 0 args))
- (with-current-buffer (process-buffer (nth 0 args))
- default-directory)))
+ (tramp-get-default-directory (process-buffer (nth 0 args)))))
;; VEC.
- ((member operation '(tramp-get-remote-gid tramp-get-remote-uid))
+ ((member operation
+ '(tramp-get-home-directory tramp-get-remote-gid
+ tramp-get-remote-groups tramp-get-remote-uid))
(tramp-make-tramp-file-name (nth 0 args)))
;; Unknown file primitive.
(t (error "Unknown file I/O primitive: %s" operation))))
-(defun tramp-find-foreign-file-name-handler (filename &optional _operation)
+(defun tramp-find-foreign-file-name-handler (vec &optional _operation)
"Return foreign file name handler if exists."
- (when (tramp-tramp-file-p filename)
+ (when (tramp-file-name-p vec)
(let ((handler tramp-foreign-file-name-handler-alist)
- elt res)
+ elt func res)
(while handler
(setq elt (car handler)
handler (cdr handler))
- (when (funcall (car elt) filename)
+ ;; Previously, this function was called with FILENAME, but now
+ ;; it's called with the VEC.
+ (when (condition-case nil
+ (funcall (setq func (car elt)) vec)
+ (error
+ (setcar elt #'ignore)
+ (unless (member 'remote-file-error debug-ignored-errors)
+ (tramp-error
+ vec 'remote-file-error
+ "Not a valid Tramp file name function `%s'" func))))
(setq handler nil
res (cdr elt))))
res)))
;; Main function.
+;;;###autoload
(defun tramp-file-name-handler (operation &rest args)
"Invoke Tramp file name handler for OPERATION and ARGS.
Fall back to normal file name handler if no Tramp file name handler exists."
@@ -2588,7 +2709,7 @@ Fall back to normal file name handler if no Tramp file
name handler exists."
(with-parsed-tramp-file-name filename nil
(let ((current-connection tramp-current-connection)
(foreign
- (tramp-find-foreign-file-name-handler filename operation))
+ (tramp-find-foreign-file-name-handler v operation))
(signal-hook-function #'tramp-signal-hook-function)
result)
;; Set `tramp-current-connection'.
@@ -2635,6 +2756,7 @@ Fall back to normal file name handler if no Tramp file
name handler exists."
(tramp-message
v 5 "Non-essential received in operation %s"
(cons operation args))
+ (let ((tramp-verbose 10)) (tramp-backtrace v))
(tramp-run-real-handler operation args))
((eq result 'suppress)
(let ((inhibit-message t))
@@ -2710,14 +2832,12 @@ This avoids problems during autoload, when `load-path'
contains
remote file names."
;; We expect all other Tramp files in the same directory as tramp.el.
(let* ((dir (expand-file-name (file-name-directory (locate-library
"tramp"))))
- (files-regexp
- (format
- "^%s$"
- (regexp-opt
- (mapcar
- #'file-name-sans-extension
- (directory-files dir nil "\\`tramp.+\\.elc?\\'"))
- 'paren))))
+ (files (delete-dups
+ (mapcar
+ #'file-name-sans-extension
+ (directory-files
+ dir nil (rx bos "tramp" (+ nonl) ".el" (? "c") eos)))))
+ (files-regexp (tramp-compat-rx bol (regexp (regexp-opt files)) eol)))
(mapatoms
(lambda (atom)
(when (and (functionp atom)
@@ -2754,6 +2874,7 @@ remote file names."
(put #'tramp-completion-file-name-handler 'operations
(mapcar #'car tramp-completion-file-name-handler-alist))
+ ;; Integrated in Emacs 27.
(when (bound-and-true-p tramp-archive-enabled)
(add-to-list 'file-name-handler-alist
(cons tramp-archive-file-name-regexp
@@ -2769,11 +2890,13 @@ remote file names."
(tramp--with-startup (tramp-register-file-name-handlers))
+;;;###tramp-autoload
(defun tramp-register-foreign-file-name-handler
(func handler &optional append)
"Register (FUNC . HANDLER) in `tramp-foreign-file-name-handler-alist'.
-FUNC is the function, which determines whether HANDLER is to be called.
-Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'."
+FUNC is the function, which takes a dissected filename and determines
+whether HANDLER is to be called. Add operations defined in
+`HANDLER-alist' to `tramp-file-name-handler'."
(add-to-list
'tramp-foreign-file-name-handler-alist `(,func . ,handler) append)
;; Mark `operations' the handler is responsible for.
@@ -2825,18 +2948,14 @@ Add operations defined in `HANDLER-alist' to
`tramp-file-name-handler'."
(defun tramp-command-completion-p (_symbol buffer)
"A predicate for Tramp interactive commands.
They are completed by \"M-x TAB\" only if the current buffer is remote."
- (with-current-buffer buffer (tramp-tramp-file-p default-directory)))
+ (tramp-tramp-file-p (tramp-get-default-directory buffer)))
(defun tramp-connectable-p (vec-or-filename)
- "Check, whether it is possible to connect the remote host w/o side-effects.
+ "Check if it is possible to connect the remote host without side-effects.
This is true, if either the remote host is already connected, or if we are
not in completion mode."
(let ((tramp-verbose 0)
- (vec
- (cond
- ((tramp-file-name-p vec-or-filename) vec-or-filename)
- ((tramp-tramp-file-p vec-or-filename)
- (tramp-dissect-file-name vec-or-filename)))))
+ (vec (tramp-ensure-dissected-file-name vec-or-filename)))
(or ;; We check this for the process related to
;; `tramp-buffer-name'; otherwise `start-file-process'
;; wouldn't run ever when `non-essential' is non-nil.
@@ -2864,11 +2983,10 @@ not in completion mode."
;; Suppress hop from completion.
(when (string-match
- (concat
- tramp-prefix-regexp
- "\\(" "\\(" tramp-remote-file-name-spec-regexp
- tramp-postfix-hop-regexp
- "\\)+" "\\)")
+ (tramp-compat-rx
+ (regexp tramp-prefix-regexp)
+ (group (+ (regexp tramp-remote-file-name-spec-regexp)
+ (regexp tramp-postfix-hop-regexp))))
fullname)
(setq hop (match-string 1 fullname)
fullname (replace-match "" nil nil fullname 1)))
@@ -2882,7 +3000,7 @@ not in completion mode."
(m (tramp-find-method method user host))
all-user-hosts)
- (unless localname ;; Nothing to complete.
+ (unless localname ;; Nothing to complete.
(if (or user host)
@@ -2950,69 +3068,69 @@ not in completion mode."
;; ["x" nil "" nil] ["x" nil "y" nil] ["x" nil "y" ""]
;; ["x" "" nil nil] ["x" "y" nil nil]
-;; "/x:y@""/[x/y@" "/x:y@z" "/[x/y@z" "/x:y@z:" "/[x/y@z]"
-;;["x" "y" nil nil] ["x" "y" "z" nil] ["x" "y" "z" ""]
+;; "/x:y@" "/[x/y@" "/x:y@z" "/[x/y@z" "/x:y@z:" "/[x/y@z]"
+;; ["x" "y" nil nil] ["x" "y" "z" nil] ["x" "y" "z" ""]
(defun tramp-completion-dissect-file-name (name)
"Return a list of `tramp-file-name' structures for NAME.
They are collected by `tramp-completion-dissect-file-name1'."
- (let* ((x-nil "\\|\\(\\)")
- (tramp-completion-ipv6-regexp
- (format
- "[^%s]*"
- (if (zerop (length tramp-postfix-ipv6-format))
- tramp-postfix-host-format
- tramp-postfix-ipv6-format)))
- ;; "/method" "/[method"
- (tramp-completion-file-name-structure1
- (list
- (concat
- tramp-prefix-regexp
- "\\(" tramp-method-regexp x-nil "\\)$")
- 1 nil nil nil))
- ;; "/method:user" "/[method/user"
- (tramp-completion-file-name-structure2
- (list
- (concat
- tramp-prefix-regexp
- "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
- "\\(" tramp-user-regexp x-nil "\\)$")
- 1 2 nil nil))
- ;; "/method:host" "/[method/host"
- (tramp-completion-file-name-structure3
- (list
- (concat
- tramp-prefix-regexp
- "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
- "\\(" tramp-host-regexp x-nil "\\)$")
- 1 nil 2 nil))
- ;; "/method:[ipv6" "/[method/ipv6"
- (tramp-completion-file-name-structure4
- (list
- (concat
- tramp-prefix-regexp
- "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
- tramp-prefix-ipv6-regexp
- "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
- 1 nil 2 nil))
- ;; "/method:user@host" "/[method/user@host"
- (tramp-completion-file-name-structure5
- (list
- (concat
- tramp-prefix-regexp
- "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
- "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
- "\\(" tramp-host-regexp x-nil "\\)$")
- 1 2 3 nil))
- ;; "/method:user@[ipv6" "/[method/user@ipv6"
- (tramp-completion-file-name-structure6
- (list
- (concat
- tramp-prefix-regexp
- "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
- "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
- tramp-prefix-ipv6-regexp
- "\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
- 1 2 3 nil)))
+ (let (;; "/method" "/[method"
+ (tramp-completion-file-name-structure1
+ (list
+ (tramp-compat-rx
+ (regexp tramp-prefix-regexp)
+ (group (? (regexp tramp-completion-method-regexp))) eol)
+ 1 nil nil nil))
+ ;; "/method:user" "/[method/user"
+ (tramp-completion-file-name-structure2
+ (list
+ (tramp-compat-rx
+ (regexp tramp-prefix-regexp)
+ (group (regexp tramp-method-regexp))
+ (regexp tramp-postfix-method-regexp)
+ (group (? (regexp tramp-user-regexp))) eol)
+ 1 2 nil nil))
+ ;; "/method:host" "/[method/host"
+ (tramp-completion-file-name-structure3
+ (list
+ (tramp-compat-rx
+ (regexp tramp-prefix-regexp)
+ (group (regexp tramp-method-regexp))
+ (regexp tramp-postfix-method-regexp)
+ (group (? (regexp tramp-host-regexp))) eol)
+ 1 nil 2 nil))
+ ;; "/method:[ipv6" "/[method/ipv6"
+ (tramp-completion-file-name-structure4
+ (list
+ (tramp-compat-rx
+ (regexp tramp-prefix-regexp)
+ (group (regexp tramp-method-regexp))
+ (regexp tramp-postfix-method-regexp)
+ (regexp tramp-prefix-ipv6-regexp)
+ (group (? (regexp tramp-ipv6-regexp))) eol)
+ 1 nil 2 nil))
+ ;; "/method:user@host" "/[method/user@host"
+ (tramp-completion-file-name-structure5
+ (list
+ (tramp-compat-rx
+ (regexp tramp-prefix-regexp)
+ (group (regexp tramp-method-regexp))
+ (regexp tramp-postfix-method-regexp)
+ (group (regexp tramp-user-regexp))
+ (regexp tramp-postfix-user-regexp)
+ (group (? (regexp tramp-host-regexp))) eol)
+ 1 2 3 nil))
+ ;; "/method:user@[ipv6" "/[method/user@ipv6"
+ (tramp-completion-file-name-structure6
+ (list
+ (tramp-compat-rx
+ (regexp tramp-prefix-regexp)
+ (group (regexp tramp-method-regexp))
+ (regexp tramp-postfix-method-regexp)
+ (group (regexp tramp-user-regexp))
+ (regexp tramp-postfix-user-regexp)
+ (regexp tramp-prefix-ipv6-regexp)
+ (group (? (regexp tramp-ipv6-regexp))) eol)
+ 1 2 3 nil)))
(delq
nil
(mapcar
@@ -3107,7 +3225,7 @@ for all methods. Resulting data are derived from default
settings."
"Return a (user host) tuple allowed to access.
User is always nil."
(let (result)
- (when (re-search-forward regexp (point-at-eol) t)
+ (when (re-search-forward regexp (line-end-position) t)
(setq result (list nil (match-string match-level))))
(or
(> (skip-chars-forward skip-chars) 0)
@@ -3137,11 +3255,11 @@ Either user or host may be nil."
Either user or host may be nil."
(let (result
(regexp
- (concat
- "^\\(" tramp-host-regexp "\\)"
- "\\([ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?")))
- (when (re-search-forward regexp (point-at-eol) t)
- (setq result (append (list (match-string 3) (match-string 1)))))
+ (tramp-compat-rx
+ bol (group (regexp tramp-host-regexp))
+ (? (+ blank) (group (regexp tramp-user-regexp))))))
+ (when (re-search-forward regexp (line-end-position) t)
+ (setq result (append (list (match-string 2) (match-string 1)))))
(forward-line 1)
result))
@@ -3153,7 +3271,8 @@ User is always nil."
(defun tramp-parse-shosts-group ()
"Return a (user host) tuple allowed to access.
User is always nil."
- (tramp-parse-group (concat "^\\(" tramp-host-regexp "\\)") 1 ","))
+ (tramp-parse-group
+ (tramp-compat-rx bol (group (regexp tramp-host-regexp))) 1 ","))
(defun tramp-parse-sconfig (filename)
"Return a list of (user host) tuples allowed to access.
@@ -3164,9 +3283,11 @@ User is always nil."
"Return a (user host) tuple allowed to access.
User is always nil."
(tramp-parse-group
- (concat "\\(?:^[ \t]*Host\\)" "\\|" "\\(?:^.+\\)"
- "\\|" "\\(" tramp-host-regexp "\\)")
- 1 " \t"))
+ (tramp-compat-rx
+ (| (: bol (* blank) "Host")
+ (: bol (+ nonl)) ;; ???
+ (group (regexp tramp-host-regexp))))
+ 1 (rx blank)))
;; Generic function.
(defun tramp-parse-shostkeys-sknownhosts (dirname regexp)
@@ -3178,21 +3299,25 @@ User is always nil."
(files (and (file-directory-p dirname) (directory-files dirname))))
(cl-loop
for f in files
- when (and (not (string-match "^\\.\\.?$" f)) (string-match regexp f))
+ when (and (not (string-match-p (rx bol (** 1 2 ".") eol) f))
+ (string-match regexp f))
collect (list nil (match-string 1 f)))))
(defun tramp-parse-shostkeys (dirname)
"Return a list of (user host) tuples allowed to access.
User is always nil."
(tramp-parse-shostkeys-sknownhosts
- dirname (concat "^key_[[:digit:]]+_\\(" tramp-host-regexp "\\)\\.pub$")))
+ dirname
+ (tramp-compat-rx
+ bol "key_" (+ digit) "_" (group (regexp tramp-host-regexp)) ".pub" eol)))
(defun tramp-parse-sknownhosts (dirname)
"Return a list of (user host) tuples allowed to access.
User is always nil."
(tramp-parse-shostkeys-sknownhosts
dirname
- (concat "^\\(" tramp-host-regexp "\\)\\.ssh-\\(dss\\|rsa\\)\\.pub$")))
+ (tramp-compat-rx
+ bol (group (regexp tramp-host-regexp)) ".ssh-" (| "dss" "rsa") ".pub"
eol)))
(defun tramp-parse-hosts (filename)
"Return a list of (user host) tuples allowed to access.
@@ -3203,7 +3328,9 @@ User is always nil."
"Return a (user host) tuple allowed to access.
User is always nil."
(tramp-parse-group
- (concat "^\\(" tramp-ipv6-regexp "\\|" tramp-host-regexp "\\)") 1 " \t"))
+ (tramp-compat-rx
+ bol (group (| (regexp tramp-ipv6-regexp) (regexp tramp-host-regexp))))
+ 1 (rx blank)))
(defun tramp-parse-passwd (filename)
"Return a list of (user host) tuples allowed to access.
@@ -3221,8 +3348,8 @@ Host is always \"localhost\"."
"Return a (user host) tuple allowed to access.
Host is always \"localhost\"."
(let (result
- (regexp (concat "^\\(" tramp-user-regexp "\\):")))
- (when (re-search-forward regexp (point-at-eol) t)
+ (regexp (tramp-compat-rx bol (group (regexp tramp-user-regexp)) ":")))
+ (when (re-search-forward regexp (line-end-position) t)
(setq result (list (match-string 1) "localhost")))
(forward-line 1)
result))
@@ -3243,7 +3370,8 @@ Host is always \"localhost\"."
"Return a (group host) tuple allowed to access.
Host is always \"localhost\"."
(let (result
- (split (split-string (buffer-substring (point) (point-at-eol)) ":")))
+ (split
+ (split-string (buffer-substring (point) (line-end-position)) ":")))
(when (member (user-login-name) (split-string (nth 3 split) "," 'omit))
(setq result (list (nth 0 split) "localhost")))
(forward-line 1)
@@ -3252,14 +3380,11 @@ Host is always \"localhost\"."
(defun tramp-parse-netrc (filename)
"Return a list of (user host) tuples allowed to access.
User may be nil."
- ;; The declaration is not sufficient at runtime, because netrc.el is
- ;; not autoloaded.
- (autoload 'netrc-parse "netrc")
(mapcar
(lambda (item)
(and (assoc "machine" item)
`(,(cdr (assoc "login" item)) ,(cdr (assoc "machine" item)))))
- (netrc-parse filename)))
+ (tramp-compat-auth-source-netrc-parse-all filename)))
(defun tramp-parse-putty (registry-or-dirname)
"Return a list of (user host) tuples allowed to access.
@@ -3274,17 +3399,265 @@ User is always nil."
(tramp-parse-putty-group registry-or-dirname)))))
;; UNIX case.
(tramp-parse-shostkeys-sknownhosts
- registry-or-dirname (concat "^\\(" tramp-host-regexp "\\)$"))))
+ registry-or-dirname
+ (tramp-compat-rx bol (group (regexp tramp-host-regexp)) eol))))
(defun tramp-parse-putty-group (registry)
- "Return a (user host) tuple allowed to access.
+ "Return a (user host) tuple allowed to access.
User is always nil."
- (let (result
- (regexp (concat (regexp-quote registry) "\\\\\\(.+\\)")))
- (when (re-search-forward regexp (point-at-eol) t)
- (setq result (list nil (match-string 1))))
- (forward-line 1)
- result))
+ (let (result
+ (regexp (tramp-compat-rx (literal registry) "\\" (group (+ nonl)))))
+ (when (re-search-forward regexp (line-end-position) t)
+ (setq result (list nil (match-string 1))))
+ (forward-line 1)
+ result))
+
+;;; Skeleton macros for file name handler functions.
+
+(defmacro tramp-skeleton-copy-directory
+ (directory _newname &optional _keep-date _parents _copy-contents &rest body)
+ "Skeleton for `tramp-*-handle-copy-directory'.
+BODY is the backend specific code."
+ (declare (indent 5) (debug t))
+ ;; `copy-directory' creates NEWNAME before running this check. So
+ ;; we do it ourselves. Therefore, we cannot also run
+ ;; `tramp-barf-if-file-missing'.
+ `(progn
+ (unless (file-exists-p ,directory)
+ (tramp-error
+ (tramp-dissect-file-name ,directory) 'file-missing ,directory))
+ ,@body))
+
+(defmacro tramp-skeleton-delete-directory (directory recursive trash &rest
body)
+ "Skeleton for `tramp-*-handle-delete-directory'.
+BODY is the backend specific code."
+ (declare (indent 3) (debug t))
+ `(with-parsed-tramp-file-name (expand-file-name ,directory) nil
+ (if (and delete-by-moving-to-trash ,trash)
+ ;; Move non-empty dir to trash only if recursive deletion was
+ ;; requested.
+ (if (not (or ,recursive (tramp-compat-directory-empty-p ,directory)))
+ (tramp-error
+ v 'file-error "Directory is not empty, not moving to trash")
+ (move-file-to-trash ,directory))
+ ,@body)
+ (tramp-flush-directory-properties v localname)))
+
+(defmacro tramp-skeleton-directory-files
+ (directory &optional full match nosort count &rest body)
+ "Skeleton for `tramp-*-handle-directory-files'.
+BODY is the backend specific code."
+ (declare (indent 5) (debug t))
+ `(or
+ (with-parsed-tramp-file-name (expand-file-name ,directory) nil
+ (tramp-barf-if-file-missing v ,directory
+ (when (file-directory-p ,directory)
+ (setq ,directory
+ (file-name-as-directory (expand-file-name ,directory)))
+ (let ((temp
+ (with-tramp-file-property v localname "directory-files"
,@body))
+ result item)
+ (while temp
+ (setq item (directory-file-name (pop temp)))
+ (when (or (null ,match) (string-match-p ,match item))
+ (push (if ,full (concat ,directory item) item)
+ result)))
+ (unless ,nosort
+ (setq result (sort result #'string<)))
+ (when (and (natnump ,count) (> ,count 0))
+ (setq result (tramp-compat-ntake ,count result)))
+ result))))
+
+ ;; Error handling.
+ (if (not (file-exists-p ,directory))
+ (tramp-error
+ (tramp-dissect-file-name ,directory) 'file-missing ,directory)
+ nil)))
+
+(defmacro tramp-skeleton-directory-files-and-attributes
+ (directory &optional full match nosort id-format count &rest body)
+ "Skeleton for `tramp-*-handle-directory-files-and-attributes'.
+BODY is the backend specific code."
+ (declare (indent 6) (debug t))
+ `(or
+ (with-parsed-tramp-file-name (expand-file-name ,directory) nil
+ (tramp-barf-if-file-missing v ,directory
+ (when (file-directory-p ,directory)
+ (let ((temp
+ (copy-tree
+ (mapcar
+ (lambda (x)
+ (cons
+ (car x)
+ (tramp-convert-file-attributes
+ v (expand-file-name (car x) localname)
+ ,id-format (cdr x))))
+ (with-tramp-file-property
+ v localname "directory-files-and-attributes"
+ ,@body))))
+ result item)
+
+ (while temp
+ (setq item (pop temp))
+ (when (or (null ,match) (string-match-p ,match (car item)))
+ (when ,full
+ (setcar item (expand-file-name (car item) ,directory)))
+ (push item result)))
+
+ (unless ,nosort
+ (setq result
+ (sort result (lambda (x y) (string< (car x) (car y))))))
+
+ (when (and (natnump ,count) (> ,count 0))
+ (setq result (tramp-compat-ntake ,count result)))
+
+ (or result
+ ;; The scripts could fail, for example with huge file size.
+ (tramp-handle-directory-files-and-attributes
+ ,directory ,full ,match ,nosort ,id-format ,count))))))
+
+ ;; Error handling.
+ (if (not (file-exists-p ,directory))
+ (tramp-error
+ (tramp-dissect-file-name ,directory) 'file-missing ,directory)
+ nil)))
+
+(defmacro tramp-skeleton-file-local-copy (filename &rest body)
+ "Skeleton for `tramp-*-handle-file-local-copy'.
+BODY is the backend specific code."
+ (declare (indent 1) (debug t))
+ `(with-parsed-tramp-file-name (file-truename ,filename) nil
+ (tramp-barf-if-file-missing v ,filename
+ (or
+ (let ((tmpfile (tramp-compat-make-temp-file ,filename)))
+ ,@body
+ (run-hooks 'tramp-handle-file-local-copy-hook)
+ tmpfile)
+
+ ;; Trigger the `file-missing' error.
+ (signal 'error nil)))))
+
+(defmacro tramp-skeleton-set-file-modes-times-uid-gid
+ (filename &rest body)
+ "Skeleton for `tramp-*-set-file-{modes,times,uid-gid}'.
+BODY is the backend specific code."
+ (declare (indent 1) (debug t))
+ `(with-parsed-tramp-file-name (expand-file-name ,filename) nil
+ (when (not (file-exists-p ,filename))
+ (tramp-error v 'file-missing ,filename))
+ (with-tramp-saved-file-properties
+ v localname
+ ;; We cannot add "file-attributes", "file-executable-p",
+ ;; "file-ownership-preserved-p", "file-readable-p",
+ ;; "file-writable-p".
+ '("file-directory-p" "file-exists-p" "file-symlinkp" "file-truename")
+ (tramp-flush-file-properties v localname))
+ ,@body))
+
+(defmacro tramp-skeleton-write-region
+ (start end filename append visit lockname mustbenew &rest body)
+ "Skeleton for `tramp-*-handle-write-region'.
+BODY is the backend specific code."
+ (declare (indent 7) (debug t))
+ ;; Sometimes, there is another file name handler responsible for
+ ;; VISIT, for example `jka-compr-handler'. We must respect this.
+ ;; See Bug#55166.
+ `(let* ((filename (expand-file-name ,filename))
+ (lockname (file-truename (or ,lockname filename)))
+ (handler (and (stringp ,visit)
+ (let ((inhibit-file-name-handlers
+ `(tramp-file-name-handler
+ tramp-crypt-file-name-handler
+ . inhibit-file-name-handlers))
+ (inhibit-file-name-operation 'write-region))
+ (find-file-name-handler ,visit 'write-region)))))
+ (with-parsed-tramp-file-name filename nil
+ (if handler
+ (progn
+ (tramp-message
+ v 5 "Calling handler `%s' for visiting `%s'" handler ,visit)
+ (funcall
+ handler 'write-region
+ ,start ,end filename ,append ,visit lockname ,mustbenew))
+
+ (when (and ,mustbenew (file-exists-p filename)
+ (or (eq ,mustbenew 'excl)
+ (not
+ (y-or-n-p
+ (format
+ "File %s exists; overwrite anyway?" filename)))))
+ (tramp-error v 'file-already-exists filename))
+
+ (let ((file-locked (eq (file-locked-p lockname) t))
+ (uid (or (file-attribute-user-id
+ (file-attributes filename 'integer))
+ (tramp-get-remote-uid v 'integer)))
+ (gid (or (file-attribute-group-id
+ (file-attributes filename 'integer))
+ (tramp-get-remote-gid v 'integer)))
+ (attributes (file-extended-attributes filename))
+ (curbuf (current-buffer)))
+
+ ;; Lock file.
+ (when (and (not (auto-save-file-name-p
+ (file-name-nondirectory filename)))
+ (file-remote-p lockname)
+ (not file-locked))
+ (setq file-locked t)
+ ;; `lock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'lock-file lockname))
+
+ ;; The body.
+ ,@body
+
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-properties v localname)
+ ;; Set the "file-exists-p" file property, because it is
+ ;; likely that it is needed shortly after `write-region'.
+ (tramp-set-file-property v localname "file-exists-p" t)
+
+ ;; We must protect `last-coding-system-used', now we have
+ ;; set it to its correct value.
+ (let (last-coding-system-used (need-chown t))
+ ;; Set file modification time.
+ (when (or (eq ,visit t) (stringp ,visit))
+ (when-let ((file-attr (file-attributes filename 'integer)))
+ (set-visited-file-modtime
+ ;; We must pass modtime explicitly, because FILENAME
+ ;; can be different from (buffer-file-name), f.e. if
+ ;; `file-precious-flag' is set.
+ (or (file-attribute-modification-time file-attr)
+ (current-time)))
+ (when (and (= (file-attribute-user-id file-attr) uid)
+ (= (file-attribute-group-id file-attr) gid))
+ (setq need-chown nil))))
+
+ ;; Set the ownership.
+ (when need-chown
+ (tramp-set-file-uid-gid filename uid gid)))
+
+ ;; Set extended attributes. We ignore possible errors,
+ ;; because ACL strings could be incompatible.
+ (when attributes
+ (ignore-errors
+ (set-file-extended-attributes filename attributes)))
+
+ ;; Unlock file.
+ (when file-locked
+ ;; `unlock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'unlock-file lockname))
+
+ ;; Sanity check.
+ (unless (equal curbuf (current-buffer))
+ (tramp-error
+ v 'file-error
+ "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))
+
+ (when (and (null noninteractive)
+ (or (eq ,visit t) (string-or-null-p ,visit)))
+ (tramp-message v 0 "Wrote %s" filename))
+ (run-hooks 'tramp-handle-write-region-hook))))))
;;; Common file name handler functions for different backends:
@@ -3294,6 +3667,42 @@ User is always nil."
(defvar tramp-handle-write-region-hook nil
"Normal hook to be run at the end of `tramp-*-handle-write-region'.")
+(defvar tramp-tolerate-tilde nil
+ "Indicator, that not expandable tilde shall be tolerated.
+Let-bind it when necessary.")
+
+;; `directory-abbrev-apply' and `directory-abbrev-make-regexp' exists
+;; since Emacs 29.1. Since this handler isn't called for older
+;; Emacs, it is save to invoke them via `tramp-compat-funcall'.
+(defun tramp-handle-abbreviate-file-name (filename)
+ "Like `abbreviate-file-name' for Tramp files."
+ (let* ((case-fold-search (file-name-case-insensitive-p filename))
+ (vec (tramp-dissect-file-name filename))
+ (tramp-tolerate-tilde t)
+ (home-dir
+ (if (let ((non-essential t)) (tramp-connectable-p vec))
+ ;; If a connection has already been established, get the
+ ;; home directory.
+ (tramp-get-home-directory vec)
+ ;; Otherwise, just use the cached value.
+ (tramp-get-connection-property vec "~"))))
+ (when home-dir
+ (setq home-dir
+ (tramp-compat-funcall
+ 'directory-abbrev-apply
+ (tramp-make-tramp-file-name vec home-dir))))
+ ;; If any elt of `directory-abbrev-alist' matches this name,
+ ;; abbreviate accordingly.
+ (setq filename (tramp-compat-funcall 'directory-abbrev-apply filename))
+ ;; Abbreviate home directory.
+ (if (and home-dir
+ (string-match
+ (tramp-compat-funcall 'directory-abbrev-make-regexp home-dir)
+ filename))
+ (tramp-make-tramp-file-name
+ vec (concat "~" (substring filename (match-beginning 1))))
+ (tramp-make-tramp-file-name (tramp-dissect-file-name filename)))))
+
(defun tramp-handle-access-file (filename string)
"Like `access-file' for Tramp files."
(setq filename (file-truename filename))
@@ -3304,16 +3713,17 @@ User is always nil."
(if (file-directory-p filename)
#'file-accessible-directory-p #'file-readable-p)
filename)
- (tramp-error
- v 'file-error (format "%s: Permission denied, %s" string filename)))
- (tramp-compat-file-missing
- v (format "%s: No such file or directory, %s" string filename)))))
+ (tramp-compat-permission-denied
+ v (format "%s: Permission denied, %s" string filename)))
+ (tramp-error
+ v 'file-missing
+ (format "%s: No such file or directory, %s" string filename)))))
(defun tramp-handle-add-name-to-file
(filename newname &optional ok-if-already-exists)
"Like `add-name-to-file' for Tramp files."
(with-parsed-tramp-file-name
- (if (tramp-tramp-file-p newname) newname filename) nil
+ (expand-file-name (if (tramp-tramp-file-p newname) newname filename)) nil
(unless (tramp-equal-remote filename newname)
(tramp-error
v 'file-error
@@ -3338,14 +3748,12 @@ User is always nil."
(defun tramp-handle-copy-directory
(directory newname &optional keep-date parents copy-contents)
"Like `copy-directory' for Tramp files."
- ;; `copy-directory' creates NEWNAME before running this check. So
- ;; we do it ourselves.
- (unless (file-exists-p directory)
- (tramp-compat-file-missing (tramp-dissect-file-name directory) directory))
- ;; We must do it file-wise.
- (tramp-run-real-handler
- #'copy-directory
- (list directory newname keep-date parents copy-contents)))
+ (tramp-skeleton-copy-directory
+ directory newname keep-date parents copy-contents
+ ;; We must do it file-wise.
+ (tramp-run-real-handler
+ #'copy-directory
+ (list directory newname keep-date parents copy-contents))))
(defun tramp-handle-directory-file-name (directory)
"Like `directory-file-name' for Tramp files."
@@ -3361,23 +3769,8 @@ User is always nil."
(defun tramp-handle-directory-files (directory &optional full match nosort
count)
"Like `directory-files' for Tramp files."
- (unless (file-exists-p directory)
- (tramp-compat-file-missing (tramp-dissect-file-name directory) directory))
- (when (file-directory-p directory)
- (setq directory (file-name-as-directory (expand-file-name directory)))
- (let ((temp (nreverse (file-name-all-completions "" directory)))
- result item)
-
- (while temp
- (setq item (directory-file-name (pop temp)))
- (when (or (null match) (string-match-p match item))
- (push (if full (concat directory item) item)
- result)))
- (unless nosort
- (setq result (sort result #'string<)))
- (when (and (natnump count) (> count 0))
- (setq result (nbutlast result (- (length result) count))))
- result)))
+ (tramp-skeleton-directory-files directory full match nosort count
+ (nreverse (file-name-all-completions "" directory))))
(defun tramp-handle-directory-files-and-attributes
(directory &optional full match nosort id-format count)
@@ -3394,10 +3787,6 @@ User is always nil."
(if (file-directory-p dir) dir (file-name-directory dir)) nil
(tramp-flush-directory-properties v localname)))
-(defvar tramp-tolerate-tilde nil
- "Indicator, that not expandable tilde shall be tolerated.
-Let-bind it when necessary.")
-
(defun tramp-handle-expand-file-name (name &optional dir)
"Like `expand-file-name' for Tramp files."
;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
@@ -3409,17 +3798,30 @@ Let-bind it when necessary.")
(setq name (tramp-compat-file-name-concat dir name)))
;; If NAME is not a Tramp file, run the real handler.
(if (not (tramp-tramp-file-p name))
- (tramp-run-real-handler #'expand-file-name (list name nil))
+ (tramp-run-real-handler #'expand-file-name (list name))
;; Dissect NAME.
(with-parsed-tramp-file-name name nil
(unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
(setq localname (concat "/" localname)))
+ ;; Expand tilde. Usually, the methods applying this handler do
+ ;; not support tilde expansion. But users could declare a
+ ;; respective connection property. (Bug#53847)
+ (when (string-match
+ (tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl))
eos)
+ localname)
+ (let ((uname (match-string 1 localname))
+ (fname (match-string 2 localname))
+ hname)
+ (when (zerop (length uname))
+ (setq uname user))
+ (when (setq hname (tramp-get-home-directory v uname))
+ (setq localname (concat hname fname)))))
;; Tilde expansion is not possible.
(when (and (not tramp-tolerate-tilde)
- (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname))
+ (string-prefix-p "~" localname))
(tramp-error v 'file-error "Cannot expand tilde in file `%s'" name))
;; Do not keep "/..".
- (when (string-match-p "^/\\.\\.?$" localname)
+ (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname)
(setq localname "/"))
;; Do normal `expand-file-name' (this does "/./" and "/../").
;; `default-directory' is bound, because on Windows there would
@@ -3427,7 +3829,7 @@ Let-bind it when necessary.")
(let ((default-directory tramp-compat-temporary-file-directory))
(tramp-make-tramp-file-name
v (tramp-drop-volume-letter
- (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
+ (if (string-prefix-p "~" localname)
localname
(tramp-run-real-handler #'expand-file-name (list
localname)))))))))
@@ -3438,9 +3840,10 @@ Let-bind it when necessary.")
(defun tramp-handle-file-directory-p (filename)
"Like `file-directory-p' for Tramp files."
- (eq (tramp-compat-file-attribute-type
- (file-attributes (file-truename filename)))
- t))
+ ;; `file-truename' could raise an error, for example due to a cyclic
+ ;; symlink.
+ (ignore-errors
+ (eq (file-attribute-type (file-attributes (file-truename filename))) t)))
(defun tramp-handle-file-equal-p (filename1 filename2)
"Like `file-equalp-p' for Tramp files."
@@ -3457,7 +3860,9 @@ Let-bind it when necessary.")
;; We don't want to run it when `non-essential' is t, or there is
;; no connection process yet.
(when (tramp-connectable-p filename)
- (not (null (file-attributes filename)))))
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (with-tramp-file-property v localname "file-exists-p"
+ (not (null (file-attributes filename)))))))
(defun tramp-handle-file-in-directory-p (filename directory)
"Like `file-in-directory-p' for Tramp files."
@@ -3470,17 +3875,13 @@ Let-bind it when necessary.")
(defun tramp-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (unless (file-exists-p filename)
- (tramp-compat-file-missing v filename))
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (copy-file filename tmpfile 'ok-if-already-exists 'keep-time)
- tmpfile)))
+ (tramp-skeleton-file-local-copy filename
+ (copy-file filename tmpfile 'ok-if-already-exists 'keep-time)))
(defun tramp-handle-file-modes (filename &optional flag)
"Like `file-modes' for Tramp files."
(when-let ((attrs (file-attributes filename))
- (mode-string (tramp-compat-file-attribute-modes attrs)))
+ (mode-string (file-attribute-modes attrs)))
(if (and (not (eq flag 'nofollow)) (eq ?l (aref mode-string 0)))
(file-modes (file-truename filename))
(tramp-mode-string-to-int mode-string))))
@@ -3512,37 +3913,32 @@ Let-bind it when necessary.")
(tramp-get-method-parameter v 'tramp-case-insensitive)
;; There isn't. So we must check, in case there's a connection already.
- (and (file-remote-p filename nil 'connected)
+ (and (let ((non-essential t)) (tramp-connectable-p v))
(with-tramp-connection-property v "case-insensitive"
(ignore-errors
(with-tramp-progress-reporter v 5 "Checking case-insensitive"
;; The idea is to compare a file with lower case
;; letters with the same file with upper case letters.
- (let ((candidate
- (tramp-compat-file-name-unquote
- (directory-file-name filename)))
+ (let ((candidate (directory-file-name filename))
case-fold-search
tmpfile)
;; Check, whether we find an existing file with
;; lower case letters. This avoids us to create a
;; temporary file.
(while (and (string-match-p
- "[[:lower:]]" (tramp-file-local-name candidate))
+ (rx lower) (tramp-file-local-name candidate))
(not (file-exists-p candidate)))
(setq candidate
(directory-file-name
(file-name-directory candidate))))
;; Nothing found, so we must use a temporary file
- ;; for comparison. `make-nearby-temp-file' is added
- ;; to Emacs 26+ like `file-name-case-insensitive-p',
- ;; so there is no compatibility problem calling it.
+ ;; for comparison.
(unless (string-match-p
- "[[:lower:]]" (tramp-file-local-name candidate))
+ (rx lower) (tramp-file-local-name candidate))
(setq tmpfile
(let ((default-directory
- (file-name-directory filename)))
- (tramp-compat-funcall
- 'make-nearby-temp-file "tramp."))
+ (file-name-directory filename)))
+ (make-nearby-temp-file "tramp."))
candidate tmpfile))
;; Check for the existence of the same file with
;; upper case letters.
@@ -3573,7 +3969,9 @@ Let-bind it when necessary.")
(and
completion-ignored-extensions
(string-match-p
- (concat (regexp-opt completion-ignored-extensions 'paren) "$") x)
+ (tramp-compat-rx
+ (regexp (regexp-opt completion-ignored-extensions)) eos)
+ x)
;; We remember the hit.
(push x hits-ignored-extensions))))))
;; No match. So we try again for ignored files.
@@ -3602,21 +4000,32 @@ Let-bind it when necessary.")
(cond
((not (file-exists-p file1)) nil)
((not (file-exists-p file2)) t)
+ ;; Tramp reads and writes timestamps on second level. So we round
+ ;; the timestamps to seconds without fractions.
+ ;; `time-convert' has been introduced with Emacs 27.1.
+ ((fboundp 'time-convert)
+ (time-less-p
+ (tramp-compat-funcall
+ 'time-convert
+ (file-attribute-modification-time (file-attributes file2)) 'integer)
+ (tramp-compat-funcall
+ 'time-convert
+ (file-attribute-modification-time (file-attributes file1)) 'integer)))
(t (time-less-p
- (tramp-compat-file-attribute-modification-time (file-attributes file2))
- (tramp-compat-file-attribute-modification-time
- (file-attributes file1))))))
+ (file-attribute-modification-time (file-attributes file2))
+ (file-attribute-modification-time (file-attributes file1))))))
(defun tramp-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-readable-p"
(or (tramp-check-cached-permissions v ?r)
;; `tramp-check-cached-permissions' doesn't handle symbolic
;; links.
(when-let ((symlink (file-symlink-p filename)))
(and (stringp symlink)
- (file-readable-p (concat (file-remote-p filename)
symlink))))))))
+ (file-readable-p
+ (concat (file-remote-p filename) symlink))))))))
(defun tramp-handle-file-regular-p (filename)
"Like `file-regular-p' for Tramp files."
@@ -3624,17 +4033,17 @@ Let-bind it when necessary.")
;; Sometimes, `file-attributes' does not return a proper value
;; even if `file-exists-p' does.
(when-let ((attr (file-attributes filename)))
- (eq ?- (aref (tramp-compat-file-attribute-modes attr) 0)))))
+ (eq ?- (aref (file-attribute-modes attr) 0)))))
(defun tramp-handle-file-remote-p (filename &optional identification connected)
"Like `file-remote-p' for Tramp files."
;; We do not want traces in the debug buffer.
(let ((tramp-verbose (min tramp-verbose 3)))
(when (tramp-tramp-file-p filename)
- (let* ((v (tramp-dissect-file-name filename))
- (p (tramp-get-connection-process v))
+ (let* ((o (tramp-dissect-file-name filename))
+ (p (tramp-get-connection-process o))
(c (and (process-live-p p)
- (tramp-get-connection-property p "connected" nil))))
+ (tramp-get-connection-property p "connected"))))
;; We expand the file name only, if there is already a connection.
(with-parsed-tramp-file-name
(if c (expand-file-name filename) filename) nil
@@ -3646,7 +4055,8 @@ Let-bind it when necessary.")
((eq identification 'user) (tramp-file-name-user-domain v))
((eq identification 'host) (tramp-file-name-host-port v))
((eq identification 'localname) localname)
- ((eq identification 'hop) hop)
+ ;; Hop exists only in original dissected file name.
+ ((eq identification 'hop) (tramp-file-name-hop o))
(t (tramp-make-tramp-file-name v 'noloc)))))))))
(defun tramp-handle-file-selinux-context (_filename)
@@ -3656,7 +4066,7 @@ Let-bind it when necessary.")
(defun tramp-handle-file-symlink-p (filename)
"Like `file-symlink-p' for Tramp files."
- (let ((x (tramp-compat-file-attribute-type (file-attributes filename))))
+ (let ((x (file-attribute-type (file-attributes filename))))
(and (stringp x) x)))
(defun tramp-handle-file-truename (filename)
@@ -3697,8 +4107,7 @@ Let-bind it when necessary.")
(expand-file-name
symlink-target
(file-name-directory v2-localname))))
- v2-localname)
- 'nohop)))
+ v2-localname))))
(when (>= numchase numchase-limit)
(tramp-error
v1 'file-error
@@ -3707,7 +4116,7 @@ Let-bind it when necessary.")
(defun tramp-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-file-property v localname "file-writable-p"
(if (file-exists-p filename)
(tramp-check-cached-permissions v ?w)
@@ -3745,9 +4154,10 @@ Let-bind it when necessary.")
(when (and (not tramp-allow-unsafe-temporary-files)
(not backup-inhibited)
(file-in-directory-p (car result) temporary-file-directory)
- (zerop (or (tramp-compat-file-attribute-user-id
- (file-attributes filename 'integer))
- tramp-unknown-id-integer))
+ (= (or (file-attribute-user-id
+ (file-attributes filename 'integer))
+ tramp-unknown-id-integer)
+ tramp-root-id-integer)
(not (with-tramp-connection-property
(tramp-get-process v) "unsafe-temporary-file"
(yes-or-no-p
@@ -3782,12 +4192,13 @@ Let-bind it when necessary.")
(goto-char (point-min))
(while (setq start
(text-property-not-all
- (point) (point-at-eol) 'dired-filename t))
+ (point) (line-end-position) 'dired-filename t))
(delete-region
start
- (or (text-property-any start (point-at-eol) 'dired-filename t)
- (point-at-eol)))
- (if (= (point-at-bol) (point-at-eol))
+ (or (text-property-any
+ start (line-end-position) 'dired-filename t)
+ (line-end-position)))
+ (if (= (line-beginning-position) (line-end-position))
;; Empty line.
(delete-region (point) (progn (forward-line) (point)))
(forward-line)))))))))
@@ -3800,13 +4211,10 @@ Let-bind it when necessary.")
(let (result local-copy remote-copy)
(with-parsed-tramp-file-name filename nil
(unwind-protect
- (if (not (file-exists-p filename))
- (let ((tramp-verbose (if visit 0 tramp-verbose)))
- (tramp-compat-file-missing v filename))
-
- (with-tramp-progress-reporter
- v 3 (format-message "Inserting `%s'" filename)
- (condition-case err
+ (condition-case err
+ (tramp-barf-if-file-missing v filename
+ (with-tramp-progress-reporter
+ v 3 (format-message "Inserting `%s'" filename)
(if (and (tramp-local-host-p v)
(let (file-name-handler-alist)
(file-readable-p localname)))
@@ -3819,7 +4227,7 @@ Let-bind it when necessary.")
;; When we shall insert only a part of the file, we
;; copy this part. This works only for the shell file
- ;; name handlers. It doesn't work for encrypted files.
+ ;; name handlers. It doesn't work for encrypted files.
(when (and (or beg end)
(tramp-sh-file-name-handler-p v)
(null tramp-crypt-enabled))
@@ -3857,8 +4265,7 @@ Let-bind it when necessary.")
(cond
((stringp remote-copy)
(file-local-copy
- (tramp-make-tramp-file-name
- v remote-copy 'nohop)))
+ (tramp-make-tramp-file-name v remote-copy)))
((stringp tramp-temp-buffer-file-name)
(copy-file
filename tramp-temp-buffer-file-name 'ok)
@@ -3884,12 +4291,16 @@ Let-bind it when necessary.")
filename local-copy)))
(setq result
(insert-file-contents
- local-copy visit beg end replace))))
- (error
- (add-hook 'find-file-not-found-functions
- `(lambda () (signal ',(car err) ',(cdr err)))
- nil t)
- (signal (car err) (cdr err))))))
+ local-copy visit beg end replace))))))
+
+ (file-error
+ (let ((tramp-verbose (if visit 0 tramp-verbose)))
+ (tramp-error v 'file-missing filename)))
+ (error
+ (add-hook 'find-file-not-found-functions
+ `(lambda () (signal ',(car err) ',(cdr err)))
+ nil t)
+ (signal (car err) (cdr err))))
;; Save exit.
(when visit
@@ -3901,11 +4312,160 @@ Let-bind it when necessary.")
(or remote-copy (null tramp-temp-buffer-file-name)))
(delete-file local-copy))
(when (stringp remote-copy)
- (delete-file (tramp-make-tramp-file-name v remote-copy 'nohop))))
+ (delete-file (tramp-make-tramp-file-name v remote-copy))))
;; Result.
(cons filename (cdr result)))))
+(defun tramp-ps-time ()
+ "Read printed time oif \"ps\" in format \"[[DD-]hh:]mm:ss\".
+Return it as number of seconds. Used in `tramp-process-attributes-ps-format'."
+ (search-forward-regexp (rx (+ blank)))
+ (search-forward-regexp (rx (? (? (group (+ digit)) "-")
+ (group (+ digit)) ":")
+ (group (+ digit)) ":"
+ ;; Seconds can also be a floating point num.
+ (group (+ (any "." digit))))
+ (line-end-position) 'noerror)
+ (+ (* 24 60 60 (string-to-number (or (match-string 1) "0")))
+ (* 60 60 (string-to-number (or (match-string 2) "0")))
+ (* 60 (string-to-number (or (match-string 3) "0")))
+ (string-to-number (or (match-string 4) "0"))))
+
+(defconst tramp-process-attributes-ps-args
+ `("-eww"
+ "-o"
+ ,(mapconcat
+ #'identity
+ '("pid"
+ "euid"
+ "euser"
+ "egid"
+ "egroup"
+ "comm:80"
+ "state"
+ "ppid"
+ "pgrp"
+ "sess"
+ "tname"
+ "tpgid"
+ "min_flt"
+ "maj_flt"
+ "times"
+ "pri"
+ "nice"
+ "thcount"
+ "vsize"
+ "rss"
+ "etimes"
+ "pcpu"
+ "pmem"
+ "args")
+ ","))
+ "List of arguments for calling \"ps\".
+See `tramp-get-process-attributes'.
+
+This list is the default value on remote GNU/Linux systems.")
+
+(defconst tramp-process-attributes-ps-format
+ '((pid . number)
+ (euid . number)
+ (user . string)
+ (egid . number)
+ (group . string)
+ (comm . 80)
+ (state . string)
+ (ppid . number)
+ (pgrp . number)
+ (sess . number)
+ (ttname . string)
+ (tpgid . number)
+ (minflt . number)
+ (majflt . number)
+ (time . number)
+ (pri . number)
+ (nice . number)
+ (thcount . number)
+ (vsize . number)
+ (rss . number)
+ (etime . number)
+ (pcpu . number)
+ (pmem . number)
+ (args . nil))
+ "Alist where each element is a cons cell of the form `\(KEY . TYPE)'.
+KEY is a key (symbol) used in `process-attributes'. TYPE is the
+printed result for KEY of the \"ps\" command, it can be `number',
+`string', a number (string of that length), a symbol (a function
+to be applied), or nil (for the last column of the \"ps\" output.
+
+This alist is used to parse the output of calling \"ps\" in
+`tramp-get-process-attributes'.
+
+This alist is the default value on remote GNU/Linux systems.")
+
+(defun tramp-get-process-attributes (vec)
+ "Return all process attributes for connection VEC.
+Parsing the remote \"ps\" output is controlled by
+`tramp-process-attributes-ps-args' and
+`tramp-process-attributes-ps-format'.
+
+It is not guaranteed, that all process attributes as described in
+`process-attributes' are returned. The additional attribute
+`pid' shall be returned always."
+ ;; Since Emacs 27.1.
+ (when (fboundp 'connection-local-criteria-for-default-directory)
+ (with-tramp-file-property vec "/" "process-attributes"
+ (ignore-errors
+ (with-temp-buffer
+ (hack-connection-local-variables-apply
+ (connection-local-criteria-for-default-directory))
+ ;; (pop-to-buffer (current-buffer))
+ (when (zerop
+ (apply
+ #'process-file
+ "ps" nil t nil tramp-process-attributes-ps-args))
+ (let (result res)
+ (goto-char (point-min))
+ (while (not (eobp))
+ ;; (tramp-test-message
+ ;; "%s" (buffer-substring (point) (line-end-position)))
+ (when (save-excursion
+ (search-forward-regexp
+ (rx digit) (line-end-position) 'noerror))
+ (setq res nil)
+ (dolist (elt tramp-process-attributes-ps-format)
+ (push
+ (cons
+ (car elt)
+ (cond
+ ((eq (cdr elt) 'number) (read (current-buffer)))
+ ((eq (cdr elt) 'string)
+ (search-forward-regexp (rx (+ (not blank))))
+ (match-string 0))
+ ((numberp (cdr elt))
+ (search-forward-regexp (rx (+ blank)))
+ (search-forward-regexp
+ (rx (+ nonl)) (+ (point) (cdr elt)))
+ (string-trim (match-string 0)))
+ ((fboundp (cdr elt))
+ (funcall (cdr elt)))
+ ((null (cdr elt))
+ (search-forward-regexp (rx (+ blank)))
+ (buffer-substring (point) (line-end-position)))))
+ res))
+ ;; `nice' could be `-'.
+ (setq res (rassq-delete-all '- res))
+ (push (append res) result))
+ (forward-line))
+ ;; Return result.
+ result)))))))
+
+(defun tramp-handle-list-system-processes ()
+ "Like `list-system-processes' for Tramp files."
+ (let ((v (tramp-dissect-file-name default-directory)))
+ (tramp-flush-file-property v "/" "process-attributes")
+ (mapcar (lambda (x) (cdr (assq 'pid x))) (tramp-get-process-attributes
v))))
+
(defun tramp-get-lock-file (file)
"Read lockfile info of FILE.
Return nil when there is no lockfile."
@@ -3932,7 +4492,10 @@ Do not set it manually, it is used buffer-local in
`tramp-get-lock-pid'.")
(defconst tramp-lock-file-info-regexp
;; USER@HOST.PID[:BOOT_TIME]
- "\\`\\(.+\\)@\\(.+\\)\\.\\([[:digit:]]+\\)\\(?::\\([[:digit:]]+\\)\\)?\\'"
+ (rx bos (group (+ nonl))
+ "@" (group (+ nonl))
+ "." (group (+ digit))
+ (? ":" (+ digit)) eos)
"The format of a lock file.")
(defun tramp-handle-file-locked-p (file)
@@ -3980,9 +4543,10 @@ Do not set it manually, it is used buffer-local in
`tramp-get-lock-pid'.")
(when (and (not tramp-allow-unsafe-temporary-files)
create-lockfiles
(file-in-directory-p lockname temporary-file-directory)
- (zerop (or (tramp-compat-file-attribute-user-id
- (file-attributes file 'integer))
- tramp-unknown-id-integer))
+ (= (or (file-attribute-user-id
+ (file-attributes file 'integer))
+ tramp-unknown-id-integer)
+ tramp-root-id-integer)
(not (with-tramp-connection-property
(tramp-get-process v) "unsafe-temporary-file"
(yes-or-no-p
@@ -3998,7 +4562,7 @@ Do not set it manually, it is used buffer-local in
`tramp-get-lock-pid'.")
(make-symbolic-link info lockname 'ok-if-already-exists)
(error
(with-file-modes #o0644
- (write-region info nil lockname)))))))))
+ (write-region info nil lockname nil 'no-message)))))))))
(defun tramp-handle-make-lock-file-name (file)
"Like `make-lock-file-name' for Tramp files."
@@ -4023,16 +4587,11 @@ Do not set it manually, it is used buffer-local in
`tramp-get-lock-pid'.")
(setq file (concat file ".elc")))
((file-exists-p (concat file ".el"))
(setq file (concat file ".el")))))
- (when must-suffix
- ;; The first condition is always true for absolute file names.
- ;; Included for safety's sake.
- (unless (or (file-name-directory file)
- (string-match-p "\\.elc?\\'" file))
- (tramp-error
- v 'file-error
- "File `%s' does not include a `.el' or `.elc' suffix" file)))
+ (when (and must-suffix (not (string-match-p (rx ".el" (? "c") eos) file)))
+ (tramp-error
+ v 'file-error "File `%s' does not include a `.el' or `.elc' suffix"
file))
(unless (or noerror (file-exists-p file))
- (tramp-compat-file-missing v file))
+ (tramp-error v 'file-missing file))
(if (not (file-exists-p file))
nil
(let ((signal-hook-function (unless noerror signal-hook-function))
@@ -4049,15 +4608,10 @@ Do not set it manually, it is used buffer-local in
`tramp-get-lock-pid'.")
(and (tramp-sh-file-name-handler-p vec)
(not (tramp-get-method-parameter vec 'tramp-copy-program))))
-(defun tramp-compute-multi-hops (vec)
- "Expands VEC according to `tramp-default-proxies-alist'."
- (let ((saved-tdpa tramp-default-proxies-alist)
- (target-alist `(,vec))
- (hops (or (tramp-file-name-hop vec) ""))
- (item vec)
- choices proxy)
-
- ;; Ad-hoc proxy definitions.
+(defun tramp-add-hops (vec)
+ "Add ad-hoc proxy definitions to `tramp-default-proxies-alist'."
+ (when-let ((hops (tramp-file-name-hop vec))
+ (item vec))
(dolist (proxy (reverse (split-string hops tramp-postfix-hop-regexp
'omit)))
(let* ((host-port (tramp-file-name-host-port item))
(user-domain (tramp-file-name-user-domain item))
@@ -4065,18 +4619,28 @@ Do not set it manually, it is used buffer-local in
`tramp-get-lock-pid'.")
tramp-prefix-format proxy tramp-postfix-host-format))
(entry
(list (and (stringp host-port)
- (concat "^" (regexp-quote host-port) "$"))
+ (tramp-compat-rx bol (literal host-port) eol))
(and (stringp user-domain)
- (concat "^" (regexp-quote user-domain) "$"))
+ (tramp-compat-rx bol (literal user-domain) eol))
(propertize proxy 'tramp-ad-hoc t))))
(tramp-message vec 5 "Add %S to `tramp-default-proxies-alist'" entry)
;; Add the hop.
(add-to-list 'tramp-default-proxies-alist entry)
(setq item (tramp-dissect-file-name proxy))))
;; Save the new value.
- (when (and hops tramp-save-ad-hoc-proxies)
+ (when tramp-save-ad-hoc-proxies
(customize-save-variable
- 'tramp-default-proxies-alist tramp-default-proxies-alist))
+ 'tramp-default-proxies-alist tramp-default-proxies-alist))))
+
+(defun tramp-compute-multi-hops (vec)
+ "Expands VEC according to `tramp-default-proxies-alist'."
+ (let ((saved-tdpa tramp-default-proxies-alist)
+ (target-alist `(,vec))
+ (item vec)
+ choices proxy)
+
+ ;; Ad-hoc proxy definitions.
+ (tramp-add-hops vec)
;; Look for proxy hosts to be passed.
(setq choices tramp-default-proxies-alist)
@@ -4136,7 +4700,7 @@ Do not set it manually, it is used buffer-local in
`tramp-get-lock-pid'.")
(setq tramp-default-proxies-alist saved-tdpa)
(tramp-user-error
vec "Host name `%s' does not match `%s'" host previous-host))
- (setq previous-host (concat "^" (regexp-quote host) "$")))))
+ (setq previous-host (tramp-compat-rx bol (literal host) eol)))))
;; Result.
target-alist))
@@ -4165,7 +4729,7 @@ substitution. SPEC-LIST is a list of char/value pairs
used for
(and ;; The method supports it.
(tramp-get-method-parameter v 'tramp-direct-async)
;; It has been indicated.
- (tramp-get-connection-property v "direct-async-process" nil)
+ (tramp-get-connection-property v "direct-async-process")
;; There's no multi-hop.
(or (not (tramp-multi-hop-p v))
(= (length (tramp-compute-multi-hops v)) 1))
@@ -4202,7 +4766,10 @@ substitution. SPEC-LIST is a list of char/value pairs
used for
(signal 'wrong-type-argument (list #'symbolp coding)))
(when (eq connection-type t)
(setq connection-type 'pty))
- (unless (memq connection-type '(nil pipe pty))
+ (unless (or (and (consp connection-type)
+ (memq (car connection-type) '(nil pipe pty))
+ (memq (cdr connection-type) '(nil pipe pty)))
+ (memq connection-type '(nil pipe pty)))
(signal 'wrong-type-argument (list #'symbolp connection-type)))
(unless (or (null filter) (eq filter t) (functionp filter))
(signal 'wrong-type-argument (list #'functionp filter)))
@@ -4216,6 +4783,7 @@ substitution. SPEC-LIST is a list of char/value pairs
used for
(get-buffer-create buffer)
;; BUFFER can be nil. We use a temporary buffer.
(generate-new-buffer tramp-temp-buffer-name)))
+ (orig-command command)
(env (mapcar
(lambda (elt)
(when (tramp-compat-string-search "=" elt) elt))
@@ -4239,14 +4807,20 @@ substitution. SPEC-LIST is a list of char/value pairs
used for
(command
(append
`("cd" ,(tramp-shell-quote-argument localname) "&&" "(" "env")
- env `(,command ")"))))
+ env `(,command ")")))
+ ;; Add remote shell if needed.
+ (command
+ (if (consp (tramp-get-method-parameter v 'tramp-direct-async))
+ (append
+ (tramp-get-method-parameter v 'tramp-direct-async)
+ `(,(mapconcat #'identity command " ")))
+ command)))
;; Check for `tramp-sh-file-name-handler', because something
;; is different between tramp-sh.el, and tramp-adb.el or
;; tramp-sshfs.el.
(let* ((sh-file-name-handler-p (tramp-sh-file-name-handler-p v))
- (adb-file-name-handler-p
- (tramp-adb-file-name-p (tramp-make-tramp-file-name v)))
+ (adb-file-name-handler-p (tramp-adb-file-name-p v))
(login-program
(tramp-get-method-parameter v 'tramp-login-program))
;; We don't create the temporary file. In fact, it
@@ -4297,27 +4871,110 @@ substitution. SPEC-LIST is a list of char/value pairs
used for
;; t. See Bug#51177.
(when filter
(set-process-filter p filter))
+ (process-put p 'remote-command orig-command)
+ (tramp-set-connection-property p "remote-command" orig-command)
(tramp-message v 6 "%s" (string-join (process-command p) " "))
p))))))
(defun tramp-handle-make-symbolic-link
- (target linkname &optional ok-if-already-exists)
+ (_target linkname &optional _ok-if-already-exists)
"Like `make-symbolic-link' for Tramp files.
This is the fallback implementation for backends which do not
support symbolic links."
- (if (tramp-tramp-file-p (expand-file-name linkname))
- (tramp-error
- (tramp-dissect-file-name (expand-file-name linkname)) 'file-error
- "make-symbolic-link not supported")
- ;; This is needed prior Emacs 26.1, where TARGET has also be
- ;; checked for a file name handler.
- (tramp-run-real-handler
- #'make-symbolic-link (list target linkname ok-if-already-exists))))
+ (tramp-error
+ (tramp-dissect-file-name (expand-file-name linkname)) 'file-error
+ "make-symbolic-link not supported"))
+
+(defun tramp-handle-memory-info ()
+ "Like `memory-info' for Tramp files."
+ (let ((result '(0 0 0 0))
+ process-file-side-effects)
+ (with-temp-buffer
+ (cond
+ ;; GNU/Linux.
+ ((zerop (process-file "cat" nil '(t) nil "/proc/meminfo"))
+ (goto-char (point-min))
+ (when
+ (re-search-forward
+ (rx bol "MemTotal:" (* space) (group (+ digit)) (* space) "kB"
eol)
+ nil 'noerror)
+ (setcar (nthcdr 0 result) (string-to-number (match-string 1))))
+ (goto-char (point-min))
+ (when
+ (re-search-forward
+ (rx bol "MemFree:" (* space) (group (+ digit)) (* space) "kB" eol)
+ nil 'noerror)
+ (setcar (nthcdr 1 result) (string-to-number (match-string 1))))
+ (goto-char (point-min))
+ (when
+ (re-search-forward
+ (rx bol "SwapTotal:" (* space) (group (+ digit)) (* space) "kB"
eol)
+ nil 'noerror)
+ (setcar (nthcdr 2 result) (string-to-number (match-string 1))))
+ (goto-char (point-min))
+ (when
+ (re-search-forward
+ (rx bol "SwapFree:" (* space) (group (+ digit)) (* space) "kB"
eol)
+ nil 'noerror)
+ (setcar (nthcdr 3 result) (string-to-number (match-string 1)))))
+
+ ;; BSD.
+ ;;
https://raw.githubusercontent.com/ocochard/myscripts/master/FreeBSD/freebsd-memory.sh
+ ((zerop (process-file "sysctl" nil '(t) nil "-a"))
+ (goto-char (point-min))
+ (when
+ (re-search-forward
+ (rx bol "hw.pagesize:" (* space) (group (+ digit)) eol)
+ nil 'noerror)
+ (let ((pagesize (string-to-number (match-string 1))))
+ (goto-char (point-min))
+ (when
+ (re-search-forward
+ (rx bol "vm.stats.vm.v_page_count:" (* space)
+ (group (+ digit)) eol)
+ nil 'noerror)
+ (setcar
+ (nthcdr 0 result)
+ (/ (* (string-to-number (match-string 1)) pagesize) 1024)))
+ (goto-char (point-min))
+ (when
+ (re-search-forward
+ (rx bol "vm.stats.vm.v_free_count:" (* space)
+ (group (+ digit)) eol)
+ nil 'noerror)
+ (setcar
+ (nthcdr 1 result)
+ (/ (* (string-to-number (match-string 1)) pagesize) 1024)))))
+ (erase-buffer)
+ (when (zerop (process-file "swapctl" nil '(t) nil "-sk"))
+ (goto-char (point-min))
+ (when
+ (re-search-forward
+ (rx bol "Total:" (* space)
+ (group (+ digit)) (* space) (group (+ digit)) eol)
+ nil 'noerror)
+ (setcar (nthcdr 2 result) (string-to-number (match-string 1)))
+ (setcar
+ (nthcdr 3 result)
+ (- (string-to-number (match-string 1))
+ (string-to-number (match-string 2)))))))))
+
+ ;; Return result.
+ (unless (equal result '(0 0 0 0))
+ result)))
+
+(defun tramp-handle-process-attributes (pid)
+ "Like `process-attributes' for Tramp files."
+ (catch 'result
+ (dolist (elt (tramp-get-process-attributes
+ (tramp-dissect-file-name default-directory)))
+ (when (= (cdr (assq 'pid elt)) pid)
+ (throw 'result elt)))))
(defun tramp-handle-shell-command (command &optional output-buffer
error-buffer)
"Like `shell-command' for Tramp files."
- (let* ((asynchronous (string-match-p "[ \t]*&[ \t]*\\'" command))
+ (let* ((asynchronous (string-match-p (rx (* blank) "&" (* blank) eos)
command))
(command (substring command 0 asynchronous))
current-buffer-p
(output-buffer-p output-buffer)
@@ -4419,11 +5076,7 @@ support symbolic links."
;; Run the process.
(setq p (start-file-process-shell-command
(buffer-name output-buffer) buffer command))
- ;; Insert error messages if they were separated.
- (when error-file
- (with-current-buffer error-buffer
- (insert-file-contents-literally error-file)))
- (if (process-live-p p)
+ (when (process-live-p p)
;; Display output.
(with-current-buffer output-buffer
(setq mode-line-process '(":%s"))
@@ -4439,14 +5092,18 @@ support symbolic links."
(insert-file-contents-literally
error-file nil nil nil 'replace))
(delete-file error-file))))
- (display-buffer output-buffer '(nil (allow-no-window . t))))
+ (display-buffer output-buffer '(nil (allow-no-window . t)))))
- (when error-file
- (delete-file error-file)))))
+ ;; Insert error messages if they were separated.
+ (when (and error-file (not (process-live-p p)))
+ (with-current-buffer error-buffer
+ (insert-file-contents-literally error-file))
+ (delete-file error-file))))
+ ;; Synchronous case.
(prog1
;; Run the process.
- (process-file-shell-command command nil buffer nil)
+ (process-file-shell-command command nil buffer)
;; Insert error messages if they were separated.
(when error-file
(with-current-buffer error-buffer
@@ -4500,14 +5157,14 @@ BUFFER might be a list, in this case STDERR is
separated."
(let (process-environment)
;; Ignore in LOCALNAME everything before "//" or "/~".
(when (stringp localname)
- (if (string-match "//\\(/\\|~\\)" localname)
+ (if (string-match-p (rx "//" (| "/" "~")) localname)
(setq filename
(replace-regexp-in-string
- "\\`/+" "/" (substitute-in-file-name localname)))
+ (rx bos (+ "/")) "/" (substitute-in-file-name localname)))
(setq filename
(concat (file-remote-p filename)
(replace-regexp-in-string
- "\\`/+" "/"
+ (rx bos (+ "/")) "/"
;; We must disable cygwin-mount file name
;; handlers and alike.
(tramp-run-real-handler
@@ -4528,7 +5185,7 @@ BUFFER might be a list, in this case STDERR is separated."
(unless time-list
(let ((remote-file-name-inhibit-cache t))
(setq time-list
- (or (tramp-compat-file-attribute-modification-time
+ (or (file-attribute-modification-time
(file-attributes (buffer-file-name)))
tramp-time-doesnt-exist))))
(unless (tramp-compat-time-equal-p time-list tramp-time-dont-know)
@@ -4552,7 +5209,7 @@ of."
t
(let* ((remote-file-name-inhibit-cache t)
(attr (file-attributes f))
- (modtime (tramp-compat-file-attribute-modification-time attr))
+ (modtime (file-attribute-modification-time attr))
(mt (visited-file-modtime)))
(cond
@@ -4569,35 +5226,10 @@ of."
(defun tramp-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename)
- lockname (file-truename (or lockname filename)))
- (with-parsed-tramp-file-name filename nil
- (when (and mustbenew (file-exists-p filename)
- (or (eq mustbenew 'excl)
- (not
- (y-or-n-p
- (format "File %s exists; overwrite anyway?" filename)))))
- (tramp-error v 'file-already-exists filename))
-
- (let ((file-locked (eq (file-locked-p lockname) t))
- (tmpfile (tramp-compat-make-temp-file filename))
+ (tramp-skeleton-write-region start end filename append visit lockname
mustbenew
+ (let ((tmpfile (tramp-compat-make-temp-file filename))
(modes (tramp-default-file-modes
- filename (and (eq mustbenew 'excl) 'nofollow)))
- (uid (or (tramp-compat-file-attribute-user-id
- (file-attributes filename 'integer))
- (tramp-get-remote-uid v 'integer)))
- (gid (or (tramp-compat-file-attribute-group-id
- (file-attributes filename 'integer))
- (tramp-get-remote-gid v 'integer))))
-
- ;; Lock file.
- (when (and (not (auto-save-file-name-p (file-name-nondirectory
filename)))
- (file-remote-p lockname)
- (not file-locked))
- (setq file-locked t)
- ;; `lock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'lock-file lockname))
-
+ filename (and (eq mustbenew 'excl) 'nofollow))))
(when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok))
;; The permissions of the temporary file should be set. If
@@ -4616,30 +5248,7 @@ of."
(error
(delete-file tmpfile)
(tramp-error
- v 'file-error "Couldn't write region to `%s'" filename)))
-
- (tramp-flush-file-properties v localname)
-
- ;; Set file modification time.
- (when (or (eq visit t) (stringp visit))
- (set-visited-file-modtime
- (or (tramp-compat-file-attribute-modification-time
- (file-attributes filename))
- (current-time))))
-
- ;; Set the ownership.
- (tramp-set-file-uid-gid filename uid gid)
-
- ;; Unlock file.
- (when file-locked
- ;; `unlock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'unlock-file lockname))
-
- ;; The end.
- (when (and (null noninteractive)
- (or (eq visit t) (string-or-null-p visit)))
- (tramp-message v 0 "Wrote %s" filename))
- (run-hooks 'tramp-handle-write-region-hook))))
+ v 'file-error "Couldn't write region to `%s'" filename))))))
;; This is used in tramp-sh.el and tramp-sudoedit.el.
(defconst tramp-stat-marker "/////"
@@ -4668,8 +5277,10 @@ of."
;; The descriptor must be a process object.
(unless (processp proc)
(tramp-error proc 'file-notify-error "Not a valid descriptor %S" proc))
- ;; There might be pending output.
- (while (tramp-accept-process-output proc 0))
+ ;; There might be pending output. Avoid problems with reentrant
+ ;; call of Tramp.
+ (ignore-errors
+ (while (tramp-accept-process-output proc 0)))
(tramp-message proc 6 "Kill %S" proc)
(delete-process proc))
@@ -4705,8 +5316,8 @@ of."
(save-window-excursion
(pop-to-buffer (tramp-get-connection-buffer vec))
(read-string (match-string 0)))))))
- (with-current-buffer (tramp-get-connection-buffer vec)
- (tramp-message vec 6 "\n%s" (buffer-string)))
+ (tramp-message
+ vec 6 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec)))
(tramp-message vec 3 "Sending login name `%s'" user)
(tramp-send-string vec (concat user tramp-local-end-of-line)))
t)
@@ -4718,7 +5329,8 @@ of."
;; Let's check whether a wrong password has been sent already.
;; Sometimes, the process returns a new password request
;; immediately after rejecting the previous (wrong) one.
- (unless (tramp-get-connection-property vec "first-password-request" nil)
+ (unless (or tramp-password-prompt-not-unique
+ (tramp-get-connection-property vec "first-password-request"))
(tramp-clear-passwd vec))
(goto-char (point-min))
(tramp-check-for-regexp proc tramp-process-action-regexp)
@@ -4726,7 +5338,13 @@ of."
;; We don't call `tramp-send-string' in order to hide the
;; password from the debug buffer and the traces.
(process-send-string
- proc (concat (tramp-read-passwd proc) tramp-local-end-of-line))
+ proc
+ (concat
+ (funcall
+ (if tramp-password-prompt-not-unique
+ #'tramp-read-passwd-without-cache #'tramp-read-passwd)
+ proc)
+ tramp-local-end-of-line))
;; Hide password prompt.
(narrow-to-region (point-max) (point-max))))
t)
@@ -4749,8 +5367,8 @@ See also `tramp-action-yn'."
(unless (yes-or-no-p (match-string 0))
(kill-process proc)
(throw 'tramp-action 'permission-denied))
- (with-current-buffer (tramp-get-connection-buffer vec)
- (tramp-message vec 6 "\n%s" (buffer-string)))
+ (tramp-message
+ vec 6 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec)))
(tramp-send-string vec (concat "yes" tramp-local-end-of-line)))
t)
@@ -4763,8 +5381,8 @@ See also `tramp-action-yesno'."
(unless (y-or-n-p (match-string 0))
(kill-process proc)
(throw 'tramp-action 'permission-denied))
- (with-current-buffer (tramp-get-connection-buffer vec)
- (tramp-message vec 6 "\n%s" (buffer-string)))
+ (tramp-message
+ vec 6 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec)))
(tramp-send-string vec (concat "y" tramp-local-end-of-line)))
t)
@@ -4772,15 +5390,15 @@ See also `tramp-action-yesno'."
"Tell the remote host which terminal type to use.
The terminal type can be configured with `tramp-terminal-type'."
(tramp-message vec 5 "Setting `%s' as terminal type." tramp-terminal-type)
- (with-current-buffer (tramp-get-connection-buffer vec)
- (tramp-message vec 6 "\n%s" (buffer-string)))
+ (tramp-message
+ vec 6 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec)))
(tramp-send-string vec (concat tramp-terminal-type tramp-local-end-of-line))
t)
(defun tramp-action-confirm-message (_proc vec)
"Return RET in order to confirm the message."
- (with-current-buffer (tramp-get-connection-buffer vec)
- (tramp-message vec 6 "\n%s" (buffer-string)))
+ (tramp-message
+ vec 6 "\n%s" (tramp-get-buffer-string (tramp-get-connection-buffer vec)))
(tramp-send-string vec tramp-local-end-of-line)
t)
@@ -4795,7 +5413,8 @@ Wait, until the connection buffer changes."
(ignore set-message-function clear-message-function)
(tramp-message vec 6 "\n%s" (buffer-string))
(tramp-check-for-regexp proc tramp-process-action-regexp)
- (with-temp-message (replace-regexp-in-string "[\r\n]" "" (match-string
0))
+ (with-temp-message
+ (replace-regexp-in-string (rx (any "\r\n")) "" (match-string 0))
;; Hide message in buffer.
(narrow-to-region (point-max) (point-max))
;; Wait for new output.
@@ -4837,8 +5456,7 @@ Wait, until the connection buffer changes."
(tramp-message vec 3 "Process has finished.")
(throw 'tramp-action 'ok))
(tramp-message vec 3 "Process has died.")
- (throw 'tramp-action 'out-of-band-failed))))
- (t nil)))
+ (throw 'tramp-action 'out-of-band-failed))))))
;;; Functions for processing the actions:
@@ -4956,8 +5574,8 @@ performed successfully. Any other value means an error."
"Lock PROC for other communication, and run BODY.
Mostly useful to protect BODY from being interrupted by timers."
(declare (indent 1) (debug t))
- `(if (tramp-get-connection-property ,proc "locked" nil)
- ;; Be kind for older Emacsen.
+ `(if (tramp-get-connection-property ,proc "locked")
+ ;; Be kind for old versions of Emacs.
(if (member 'remote-file-error debug-ignored-errors)
(throw 'non-essential 'non-essential)
(tramp-error
@@ -4968,9 +5586,6 @@ Mostly useful to protect BODY from being interrupted by
timers."
,@body)
(tramp-flush-connection-property ,proc "locked"))))
-(font-lock-add-keywords
- 'emacs-lisp-mode '("\\<with-tramp-locked-connection\\>"))
-
(defun tramp-accept-process-output (proc &optional timeout)
"Like `accept-process-output' for Tramp processes.
This is needed in order to hide `last-coding-system-used', which is set
@@ -5012,7 +5627,7 @@ Erase echoed commands if exists."
;; Check whether we need to remove echo output. The max length of
;; the echo mark regexp is taken for search. We restrict the
;; search for the second echo mark to PIPE_BUF characters.
- (when (and (tramp-get-connection-property proc "check-remote-echo" nil)
+ (when (and (tramp-get-connection-property proc "check-remote-echo")
(re-search-forward
tramp-echoed-echo-mark-regexp
(+ (point) (* 5 tramp-echo-mark-marker-length)) t))
@@ -5028,7 +5643,7 @@ Erase echoed commands if exists."
(delete-region begin (point))
(goto-char (point-min)))))
- (when (or (not (tramp-get-connection-property proc "check-remote-echo"
nil))
+ (when (or (not (tramp-get-connection-property proc "check-remote-echo"))
;; Sometimes, the echo string is suppressed on the remote side.
(not (string-equal
(substring-no-properties
@@ -5069,8 +5684,8 @@ nil."
;; The process could have timed out, for example due to session
;; timeout of sudo. The process buffer does not exist any longer then.
(ignore-errors
- (with-current-buffer (process-buffer proc)
- (tramp-message proc 6 "\n%s" (buffer-string))))
+ (tramp-message
+ proc 6 "\n%s" (tramp-get-buffer-string (process-buffer proc))))
(unless found
(if timeout
(tramp-error
@@ -5090,7 +5705,7 @@ The STRING is expected to use Unix line-endings, but the
lines sent to
the remote host use line-endings as defined in the variable
`tramp-rsh-end-of-line'. The communication buffer is erased before sending."
(let* ((p (tramp-get-connection-process vec))
- (chunksize (tramp-get-connection-property p "chunksize" nil)))
+ (chunksize (tramp-get-connection-property p "chunksize")))
(unless p
(tramp-error
vec 'file-error "Can't send string to remote host -- not logged in"))
@@ -5128,14 +5743,15 @@ the remote host use line-endings as defined in the
variable
(unless (process-live-p proc)
(let ((vec (process-get proc 'vector))
(buf (process-buffer proc))
- (prompt (tramp-get-connection-property proc "prompt" nil)))
+ (prompt (tramp-get-connection-property proc "prompt")))
(when vec
(tramp-message vec 5 "Sentinel called: `%S' `%s'" proc event)
(tramp-flush-connection-properties proc)
- (tramp-flush-directory-properties vec ""))
+ (tramp-flush-directory-properties vec "/"))
(when (buffer-live-p buf)
(with-current-buffer buf
- (when (and prompt (tramp-search-regexp (regexp-quote prompt)))
+ (when (and prompt
+ (tramp-search-regexp (tramp-compat-rx (literal prompt))))
(delete-region (point) (point-max))))))))
(defun tramp-get-inode (vec)
@@ -5292,10 +5908,12 @@ If FILENAME is remote, a file name handler is called."
(let* ((dir (file-name-directory filename))
(modes (file-modes dir)))
(when (and modes (not (zerop (logand modes #o2000))))
- (setq gid (tramp-compat-file-attribute-group-id (file-attributes dir)))))
+ (setq gid (file-attribute-group-id (file-attributes dir)))))
- (if-let ((handler (find-file-name-handler filename 'tramp-set-file-uid-gid)))
- (funcall handler #'tramp-set-file-uid-gid filename uid gid)
+ (if (tramp-tramp-file-p filename)
+ (funcall (if (tramp-crypt-file-name-p filename)
+ #'tramp-crypt-file-name-handler #'tramp-file-name-handler)
+ #'tramp-set-file-uid-gid filename uid gid)
;; On W32 systems, "chown" does not work.
(unless (memq system-type '(ms-dos windows-nt))
(let ((uid (or (and (natnump uid) uid) (tramp-get-local-uid 'integer)))
@@ -5321,8 +5939,7 @@ ID-FORMAT valid values are `string' and `integer'."
;; `group-name' has been introduced with Emacs 27.1.
((and (fboundp 'group-name) (equal id-format 'string))
(tramp-compat-funcall 'group-name (group-gid)))
- ((tramp-compat-file-attribute-group-id
- (file-attributes "~/" id-format))))))
+ ((file-attribute-group-id (file-attributes "~/" id-format))))))
(defun tramp-get-local-locale (&optional vec)
"Determine locale, supporting UTF8 if possible.
@@ -5338,7 +5955,7 @@ VEC is used for tracing."
(while candidates
(goto-char (point-min))
(if (string-match-p
- (format "^%s\r?$" (regexp-quote (car candidates)))
+ (tramp-compat-rx bol (literal (car candidates)) (? "\r") eol)
(buffer-string))
(setq locale (car candidates)
candidates nil)
@@ -5351,86 +5968,225 @@ VEC is used for tracing."
"Check `file-attributes' caches for VEC.
Return t if according to the cache access type ACCESS is known to
be granted."
- (let ((result nil)
- (offset (cond
- ((eq ?r access) 1)
- ((eq ?w access) 2)
- ((eq ?x access) 3)
- ((eq ?s access) 3))))
- (dolist (suffix '("string" "integer") result)
- (setq
- result
- (or
- result
- (let ((file-attr
- (or
- (tramp-get-file-property
- vec (tramp-file-name-localname vec)
- (concat "file-attributes-" suffix) nil)
- (file-attributes
- (tramp-make-tramp-file-name vec) (intern suffix))))
- (remote-uid (tramp-get-remote-uid vec (intern suffix)))
- (remote-gid (tramp-get-remote-gid vec (intern suffix)))
- (unknown-id
- (if (string-equal suffix "string")
- tramp-unknown-id-string tramp-unknown-id-integer)))
- (and
- file-attr
- (or
- ;; Not a symlink.
- (eq t (tramp-compat-file-attribute-type file-attr))
- (null (tramp-compat-file-attribute-type file-attr)))
- (or
- ;; World accessible.
- (eq access
- (aref (tramp-compat-file-attribute-modes file-attr)
- (+ offset 6)))
- ;; User accessible and owned by user.
- (and
- (eq access
- (aref (tramp-compat-file-attribute-modes file-attr) offset))
- (or (equal remote-uid unknown-id)
- (equal remote-uid
- (tramp-compat-file-attribute-user-id file-attr))
- (equal unknown-id
- (tramp-compat-file-attribute-user-id file-attr))))
- ;; Group accessible and owned by user's principal group.
- (and
- (eq access
- (aref (tramp-compat-file-attribute-modes file-attr)
- (+ offset 3)))
- (or (equal remote-gid unknown-id)
- (equal remote-gid
- (tramp-compat-file-attribute-group-id file-attr))
- (equal unknown-id
- (tramp-compat-file-attribute-group-id
- file-attr))))))))))))
+ (when-let ((offset (cond
+ ((eq ?r access) 1)
+ ((eq ?w access) 2)
+ ((eq ?x access) 3)
+ ((eq ?s access) 3)))
+ (file-attr (file-attributes (tramp-make-tramp-file-name vec)))
+ (remote-uid (tramp-get-remote-uid vec 'integer))
+ (remote-gid (tramp-get-remote-gid vec 'integer)))
+ (or
+ ;; Not a symlink.
+ (eq t (file-attribute-type file-attr))
+ (null (file-attribute-type file-attr)))
+ (or
+ ;; World accessible.
+ (eq access (aref (file-attribute-modes file-attr) (+ offset 6)))
+ ;; User accessible and owned by user.
+ (and
+ (eq access (aref (file-attribute-modes file-attr) offset))
+ (or (equal remote-uid tramp-root-id-integer)
+ (equal remote-uid tramp-unknown-id-integer)
+ (equal remote-uid (file-attribute-user-id file-attr))
+ (equal tramp-unknown-id-integer (file-attribute-user-id file-attr))))
+ ;; Group accessible and owned by user's principal group.
+ (and
+ (eq access
+ (aref (file-attribute-modes file-attr) (+ offset 3)))
+ (or (equal remote-gid tramp-root-id-integer)
+ (equal remote-gid tramp-unknown-id-integer)
+ (equal remote-gid (file-attribute-group-id file-attr))
+ (equal tramp-unknown-id-integer
+ (file-attribute-group-id file-attr))))
+ ;; Group accessible and owned by user's secondary group.
+ (and
+ (eq access
+ (aref (file-attribute-modes file-attr) (+ offset 3)))
+ (member (file-attribute-group-id file-attr)
+ (tramp-get-remote-groups vec 'integer))))))
+
+(defmacro tramp-convert-file-attributes (vec localname id-format attr)
+ "Convert `file-attributes' ATTR generated Tramp backend functions.
+Convert file mode bits to string and set virtual device number.
+Set file uid and gid according to ID-FORMAT. LOCALNAME is used
+to cache the result. Return the modified ATTR."
+ (declare (indent 3) (debug t))
+ `(with-tramp-file-property
+ ,vec ,localname (format "file-attributes-%s" (or ,id-format 'integer))
+ (when-let
+ ((result
+ (with-tramp-file-property ,vec ,localname "file-attributes"
+ (when-let ((attr ,attr))
+ (save-match-data
+ ;; Remove color escape sequences from symlink.
+ (when (stringp (car attr))
+ (while (string-match
+ tramp-display-escape-sequence-regexp (car attr))
+ (setcar attr (replace-match "" nil nil (car attr)))))
+ ;; Convert uid and gid. Use `tramp-unknown-id-integer'
+ ;; as indication of unusable value.
+ (when (consp (nth 2 attr))
+ (when (and (numberp (cdr (nth 2 attr)))
+ (< (cdr (nth 2 attr)) 0))
+ (setcdr (car (nthcdr 2 attr)) tramp-unknown-id-integer))
+ (when (and (floatp (cdr (nth 2 attr)))
+ (<= (cdr (nth 2 attr)) most-positive-fixnum))
+ (setcdr (car (nthcdr 2 attr)) (round (cdr (nth 2 attr))))))
+ (when (consp (nth 3 attr))
+ (when (and (numberp (cdr (nth 3 attr)))
+ (< (cdr (nth 3 attr)) 0))
+ (setcdr (car (nthcdr 3 attr)) tramp-unknown-id-integer))
+ (when (and (floatp (cdr (nth 3 attr)))
+ (<= (cdr (nth 3 attr)) most-positive-fixnum))
+ (setcdr (car (nthcdr 3 attr)) (round (cdr (nth 3 attr))))))
+ ;; Convert last access time.
+ (unless (listp (nth 4 attr))
+ (setcar (nthcdr 4 attr) (seconds-to-time (nth 4 attr))))
+ ;; Convert last modification time.
+ (unless (listp (nth 5 attr))
+ (setcar (nthcdr 5 attr) (seconds-to-time (nth 5 attr))))
+ ;; Convert last status change time.
+ (unless (listp (nth 6 attr))
+ (setcar (nthcdr 6 attr) (seconds-to-time (nth 6 attr))))
+ ;; Convert file size.
+ (when (< (nth 7 attr) 0)
+ (setcar (nthcdr 7 attr) -1))
+ (when (and (floatp (nth 7 attr))
+ (<= (nth 7 attr) most-positive-fixnum))
+ (setcar (nthcdr 7 attr) (round (nth 7 attr))))
+ ;; Convert file mode bits to string.
+ (unless (stringp (nth 8 attr))
+ (setcar (nthcdr 8 attr)
+ (tramp-file-mode-from-int (nth 8 attr)))
+ (when (stringp (car attr))
+ (aset (nth 8 attr) 0 ?l)))
+ ;; Convert directory indication bit.
+ (when (string-prefix-p "d" (nth 8 attr))
+ (setcar attr t))
+ ;; Convert symlink from `tramp-do-file-attributes-with-stat'.
+ ;; Decode also multibyte string.
+ (when (consp (car attr))
+ (setcar attr
+ (and (stringp (caar attr))
+ (string-match
+ (rx (+ nonl) " -> " nonl (group (+ nonl)) nonl)
+ (caar attr))
+ (decode-coding-string
+ (match-string 1 (caar attr)) 'utf-8))))
+ ;; Set file's gid change bit.
+ (setcar
+ (nthcdr 9 attr)
+ (not (= (cdr (nth 3 attr))
+ (or (tramp-get-remote-gid ,vec 'integer)
+ tramp-unknown-id-integer))))
+ ;; Convert inode.
+ (when (floatp (nth 10 attr))
+ (setcar (nthcdr 10 attr)
+ (condition-case nil
+ (let ((high (nth 10 attr))
+ middle low)
+ (if (<= high most-positive-fixnum)
+ (floor high)
+ ;; The low 16 bits.
+ (setq low (mod high #x10000)
+ high (/ high #x10000))
+ (if (<= high most-positive-fixnum)
+ (cons (floor high) (floor low))
+ ;; The middle 24 bits.
+ (setq middle (mod high #x1000000)
+ high (/ high #x1000000))
+ (cons (floor high)
+ (cons (floor middle) (floor low))))))
+ ;; Inodes can be incredible huge. We
+ ;; must hide this.
+ (error (tramp-get-inode ,vec)))))
+ ;; Set virtual device number.
+ (setcar (nthcdr 11 attr)
+ (tramp-get-device ,vec))
+ attr)))))
+
+ ;; Return normalized result.
+ (append (tramp-compat-take 2 result)
+ (if (eq ,id-format 'string)
+ (list (car (nth 2 result)) (car (nth 3 result)))
+ (list (cdr (nth 2 result)) (cdr (nth 3 result))))
+ (nthcdr 4 result)))))
+
+(defun tramp-get-home-directory (vec &optional user)
+ "The remote home directory for connection VEC as local file name.
+If USER is a string, return its home directory instead of the
+user identified by VEC. If there is no user specified in either
+VEC or USER, or if there is no home directory, return nil."
+ (and (tramp-file-name-p vec)
+ (with-tramp-connection-property vec (concat "~" user)
+ (tramp-file-name-handler #'tramp-get-home-directory vec user))))
(defun tramp-get-remote-uid (vec id-format)
"The uid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
- (with-tramp-connection-property vec (format "uid-%s" id-format)
- (or (when-let
- ((handler
- (find-file-name-handler
- (tramp-make-tramp-file-name vec) 'tramp-get-remote-uid)))
- (funcall handler #'tramp-get-remote-uid vec id-format))
- ;; Ensure there is a valid result.
- (and (equal id-format 'integer) tramp-unknown-id-integer)
- (and (equal id-format 'string) tramp-unknown-id-string))))
+ (or (and (tramp-file-name-p vec)
+ (with-tramp-connection-property vec (format "uid-%s" id-format)
+ (tramp-file-name-handler #'tramp-get-remote-uid vec id-format)))
+ ;; Ensure there is a valid result.
+ (and (equal id-format 'integer) tramp-unknown-id-integer)
+ (and (equal id-format 'string) tramp-unknown-id-string)))
(defun tramp-get-remote-gid (vec id-format)
"The gid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
- (with-tramp-connection-property vec (format "gid-%s" id-format)
- (or (when-let
- ((handler
- (find-file-name-handler
- (tramp-make-tramp-file-name vec) 'tramp-get-remote-gid)))
- (funcall handler #'tramp-get-remote-gid vec id-format))
- ;; Ensure there is a valid result.
- (and (equal id-format 'integer) tramp-unknown-id-integer)
- (and (equal id-format 'string) tramp-unknown-id-string))))
+ (or (and (tramp-file-name-p vec)
+ (with-tramp-connection-property vec (format "gid-%s" id-format)
+ (tramp-file-name-handler #'tramp-get-remote-gid vec id-format)))
+ ;; Ensure there is a valid result.
+ (and (equal id-format 'integer) tramp-unknown-id-integer)
+ (and (equal id-format 'string) tramp-unknown-id-string)))
+
+(defun tramp-get-remote-groups (vec id-format)
+ "The list of groups of the remote connection VEC, in ID-FORMAT.
+ID-FORMAT valid values are `string' and `integer'."
+ (and (tramp-file-name-p vec)
+ (with-tramp-connection-property vec (format "groups-%s" id-format)
+ (tramp-file-name-handler #'tramp-get-remote-groups vec id-format))))
+
+(defun tramp-read-id-output (vec)
+ "Read in connection buffer the output of the `id' command.
+Set connection properties \"{uid,gid.groups}-{integer,string}\"."
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (let (uid-integer uid-string
+ gid-integer gid-string
+ groups-integer groups-string)
+ (goto-char (point-min))
+ ;; Read uid.
+ (when (re-search-forward
+ (rx "uid=" (group (+ digit)) "(" (group (+ (any "_" word))) ")")
+ nil 'noerror)
+ (setq uid-integer (string-to-number (match-string 1))
+ uid-string (match-string 2)))
+ ;; Read gid.
+ (when (re-search-forward
+ (rx "gid=" (group (+ digit)) "(" (group (+ (any "_" word))) ")")
+ nil 'noerror)
+ (setq gid-integer (string-to-number (match-string 1))
+ gid-string (match-string 2)))
+ ;; Read groups.
+ (when (re-search-forward (rx "groups=") nil 'noerror)
+ (while (looking-at
+ (rx (group (+ digit)) "(" (group (+ (any "_" word))) ")"))
+ (setq groups-integer (cons (string-to-number (match-string 1))
+ groups-integer)
+ groups-string (cons (match-string 2) groups-string))
+ (goto-char (match-end 0))
+ (skip-chars-forward ",")))
+ ;; Set connection properties.
+ (tramp-set-connection-property vec "uid-integer" uid-integer)
+ (tramp-set-connection-property vec "uid-string" uid-string)
+ (tramp-set-connection-property vec "gid-integer" gid-integer)
+ (tramp-set-connection-property vec "gid-string" gid-string)
+ (tramp-set-connection-property
+ vec "groups-integer" (nreverse groups-integer))
+ (tramp-set-connection-property
+ vec "groups-string" (nreverse groups-string)))))
(defun tramp-local-host-p (vec)
"Return t if this points to the local host, nil otherwise.
@@ -5450,20 +6206,14 @@ This handles also chrooted environments, which are not
regarded as local."
(null tramp-crypt-enabled)
;; The local temp directory must be writable for the other user.
(file-writable-p
- (tramp-make-tramp-file-name
- vec tramp-compat-temporary-file-directory 'nohop))
+ (tramp-make-tramp-file-name vec tramp-compat-temporary-file-directory))
;; On some systems, chown runs only for root.
(or (zerop (user-uid))
- (zerop (tramp-get-remote-uid vec 'integer))))))
+ (= (tramp-get-remote-uid vec 'integer) tramp-root-id-integer)))))
(defun tramp-get-remote-tmpdir (vec)
"Return directory for temporary files on the remote host identified by VEC."
(with-tramp-connection-property (tramp-get-process vec) "remote-tmpdir"
- ;; Prior Tramp 2.5.3.2, the connection property "tmpdir" did exist
- ;; with a remote file name. This must be discarded. (Bug#57800)
- (when-let ((tmpdir (tramp-get-connection-property vec "tmpdir" nil)))
- (when (tramp-tramp-file-p tmpdir)
- (tramp-flush-connection-property vec "tmpdir")))
(let ((dir
(tramp-make-tramp-file-name
vec (or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp"))))
@@ -5480,21 +6230,16 @@ This handles also chrooted environments, which are not
regarded as local."
(defun tramp-make-tramp-temp-file (vec)
"Create a temporary file on the remote host identified by VEC.
Return the local name of the temporary file."
- (let (result)
- (while (not result)
- ;; `make-temp-file' would be the natural choice for
- ;; implementation. But it calls `write-region' internally,
- ;; which also needs a temporary file - we would end in an
- ;; infinite loop.
- (setq result (tramp-make-tramp-temp-name vec))
- (if (file-exists-p result)
- (setq result nil)
- ;; This creates the file by side effect.
- (set-file-times result)
- (set-file-modes result #o0700)))
-
- ;; Return the local part.
- (tramp-file-local-name result)))
+ (let (create-lockfiles)
+ (cl-letf (((symbol-function 'tramp-remote-acl-p) #'ignore)
+ ((symbol-function 'tramp-remote-selinux-p) #'ignore)
+ ((symbol-function 'tramp-smb-remote-acl-p) #'ignore)
+ ((symbol-function 'tramp-sudoedit-remote-acl-p) #'ignore)
+ ((symbol-function 'tramp-sudoedit-remote-selinux-p) #'ignore))
+ (tramp-file-local-name
+ (make-temp-file
+ (expand-file-name
+ tramp-temp-name-prefix (tramp-get-remote-tmpdir vec)))))))
(defun tramp-delete-temp-file-function ()
"Remove temporary files related to current buffer."
@@ -5550,9 +6295,10 @@ this file, if that variable is non-nil."
(when (and (not tramp-allow-unsafe-temporary-files)
auto-save-default
(file-in-directory-p result temporary-file-directory)
- (zerop (or (tramp-compat-file-attribute-user-id
- (file-attributes filename 'integer))
- tramp-unknown-id-integer))
+ (= (or (file-attribute-user-id
+ (file-attributes filename 'integer))
+ tramp-unknown-id-integer)
+ tramp-root-id-integer)
(not (with-tramp-connection-property
(tramp-get-process v) "unsafe-temporary-file"
(yes-or-no-p
@@ -5569,7 +6315,7 @@ ALIST is of the form ((FROM . TO) ...)."
(let* ((pr (car alist))
(from (car pr))
(to (cdr pr)))
- (while (string-match (regexp-quote from) string)
+ (while (string-match (tramp-compat-rx (literal from)) string)
(setq string (replace-match to t t string)))
(setq alist (cdr alist))))
string))
@@ -5586,8 +6332,7 @@ ALIST is of the form ((FROM . TO) ...)."
(defun tramp-handle-make-nearby-temp-file (prefix &optional dir-flag suffix)
"Like `make-nearby-temp-file' for Tramp files."
- (let ((temporary-file-directory
- (tramp-compat-temporary-file-directory-function)))
+ (let ((temporary-file-directory (temporary-file-directory)))
(make-temp-file prefix dir-flag suffix)))
;;; Compatibility functions section:
@@ -5610,14 +6355,12 @@ are written with verbosity of 6."
(with-temp-buffer
(setq result
(apply
- #'call-process program infile (or destination t) display args))
+ #'call-process program infile (or destination t) display args)
+ output (tramp-get-buffer-string destination))
;; `result' could also be an error string.
(when (stringp result)
(setq error result
- result 1))
- (with-current-buffer
- (if (bufferp destination) destination (current-buffer))
- (setq output (buffer-string))))
+ result 1)))
(error
(setq error (error-message-string err)
result 1)))
@@ -5648,10 +6391,10 @@ are written with verbosity of 6."
;; `result' could also be an error string.
(when (stringp result)
(signal 'file-error (list result)))
- (with-current-buffer (if (bufferp buffer) buffer (current-buffer))
- (if (zerop result)
- (tramp-message vec 6 "%d" result)
- (tramp-message vec 6 "%d\n%s" result (buffer-string)))))
+ (if (zerop result)
+ (tramp-message vec 6 "%d" result)
+ (tramp-message
+ vec 6 "%d\n%s" result (tramp-get-buffer-string buffer))))
(error
(setq result 1)
(tramp-message vec 6 "%d\n%s" result (error-message-string err))))
@@ -5674,7 +6417,7 @@ verbosity of 6."
(apply #'process-lines program args)
(error
(tramp-error vec (car err) (cdr err)))))
- (tramp-message vec 6 "%s" result)
+ (tramp-message vec 6 "\n%s" (mapconcat #'identity result "\n"))
result))
(defun tramp-process-running-p (process-name)
@@ -5696,20 +6439,22 @@ verbosity of 6."
;; tramp-cache-read-persistent-data t)'" instead.
(defun tramp-read-passwd (proc &optional prompt)
"Read a password from user (compat function).
-Consults the auth-source package.
-Invokes `password-read' if available, `read-passwd' else."
+Consults the auth-source package."
(let* (;; If `auth-sources' contains "~/.authinfo.gpg", and
;; `exec-path' contains a relative file name like ".", it
;; could happen that the "gpg" command is not found. So we
;; adapt `default-directory'. (Bug#39389, Bug#39489)
(default-directory tramp-compat-temporary-file-directory)
(case-fold-search t)
- (key (tramp-make-tramp-file-name
- ;; In tramp-sh.el, we must use "password-vector" due to
- ;; multi-hop.
- (tramp-get-connection-property
- proc "password-vector" (process-get proc 'vector))
- 'noloc 'nohop))
+ ;; In tramp-sh.el, we must use "password-vector" due to
+ ;; multi-hop.
+ (vec (tramp-get-connection-property
+ proc "password-vector" (process-get proc 'vector)))
+ (key (tramp-make-tramp-file-name vec 'noloc))
+ (method (tramp-file-name-method vec))
+ (user (or (tramp-file-name-user-domain vec)
+ (tramp-get-connection-property key "login-as")))
+ (host (tramp-file-name-host-port vec))
(pw-prompt
(or prompt
(with-current-buffer (process-buffer proc)
@@ -5719,68 +6464,66 @@ Invokes `password-read' if available, `read-passwd'
else."
(format "%s for %s " (capitalize (match-string 1)) key)))))
(auth-source-creation-prompts `((secret . ,pw-prompt)))
;; Use connection-local value.
- (auth-sources (with-current-buffer (process-buffer proc) auth-sources))
+ (auth-sources (buffer-local-value 'auth-sources (process-buffer proc)))
;; We suspend the timers while reading the password.
(stimers (with-timeout-suspend))
auth-info auth-passwd)
(unwind-protect
- (with-parsed-tramp-file-name key nil
- (setq tramp-password-save-function nil
- user
- (or user (tramp-get-connection-property key "login-as" nil)))
- (prog1
- (or
- ;; See if auth-sources contains something useful.
- (ignore-errors
- (and (tramp-get-connection-property
- v "first-password-request" nil)
- ;; Try with Tramp's current method.
- (setq auth-info
- (car
- (auth-source-search
- :max 1
- (and user :user)
- (if domain
- (concat
- user tramp-prefix-domain-format domain)
- user)
- :host
- (if port
- (concat
- host tramp-prefix-port-format port)
- host)
- :port method
- :require (cons :secret (and user '(:user)))
- :create t))
- tramp-password-save-function
- (plist-get auth-info :save-function)
- auth-passwd (plist-get auth-info :secret)))
- (while (functionp auth-passwd)
- (setq auth-passwd (funcall auth-passwd)))
- auth-passwd)
-
- ;; Try the password cache. Exists since Emacs 26.1.
- (progn
- (setq auth-passwd (password-read pw-prompt key)
- tramp-password-save-function
- (lambda () (password-cache-add key auth-passwd)))
- auth-passwd)
-
- ;; Else, get the password interactively w/o cache.
- (read-passwd pw-prompt))
+ ;; We cannot use `with-parsed-tramp-file-name', because it
+ ;; expands the file name.
+ (or
+ (setq tramp-password-save-function nil)
+ ;; See if auth-sources contains something useful.
+ (ignore-errors
+ (and (tramp-get-connection-property vec "first-password-request")
+ ;; Try with Tramp's current method. If there is no
+ ;; user name, `:create' triggers to ask for. We
+ ;; suppress it.
+ (setq auth-info
+ (car
+ (auth-source-search
+ :max 1 :user user :host host :port method
+ :require (cons :secret (and user '(:user)))
+ :create (and user t)))
+ tramp-password-save-function
+ (plist-get auth-info :save-function)
+ auth-passwd
+ (tramp-compat-auth-info-password auth-info))))
+
+ ;; Try the password cache.
+ (progn
+ (setq auth-passwd (password-read pw-prompt key)
+ tramp-password-save-function
+ (lambda () (password-cache-add key auth-passwd)))
+ auth-passwd))
- ;; Workaround. Prior Emacs 28.1, auth-source has saved
- ;; empty passwords. See discussion in Bug#50399.
- (when (zerop (length auth-passwd))
- (setq tramp-password-save-function nil))
- (tramp-set-connection-property v "first-password-request" nil)))
+ ;; Workaround. Prior Emacs 28.1, auth-source has saved empty
+ ;; passwords. See discussion in Bug#50399.
+ (when (zerop (length auth-passwd))
+ (setq tramp-password-save-function nil))
+ (tramp-set-connection-property vec "first-password-request" nil)
;; Reenable the timers.
(with-timeout-unsuspend stimers))))
(put #'tramp-read-passwd 'tramp-suppress-trace t)
+(defun tramp-read-passwd-without-cache (proc &optional prompt)
+ "Read a password from user (compat function)."
+ ;; We suspend the timers while reading the password.
+ (let ((stimers (with-timeout-suspend)))
+ (unwind-protect
+ (password-read
+ (or prompt
+ (with-current-buffer (process-buffer proc)
+ (tramp-check-for-regexp proc tramp-password-prompt-regexp)
+ (match-string 0))))
+ ;; Reenable the timers.
+ (with-timeout-unsuspend stimers))))
+
+(put #'tramp-read-passwd-without-cache 'tramp-suppress-trace t)
+
(defun tramp-clear-passwd (vec)
"Clear password cache for connection related to VEC."
(let ((method (tramp-file-name-method vec))
@@ -5793,7 +6536,7 @@ Invokes `password-read' if available, `read-passwd' else."
(auth-source-forget
`(:max 1 ,(and user-domain :user) ,user-domain
:host ,host-port :port ,method))
- (password-cache-remove (tramp-make-tramp-file-name vec 'noloc 'nohop))))
+ (password-cache-remove (tramp-make-tramp-file-name vec 'noloc))))
(put #'tramp-clear-passwd 'tramp-suppress-trace t)
@@ -5835,15 +6578,13 @@ would use a wrong quoting for local file names. See
`w32-shell-name'."
Only works for Bourne-like shells."
(let ((system-type 'not-windows))
(save-match-data
- (let ((result (tramp-unquote-shell-quote-argument s))
- (nl (regexp-quote (format "\\%s" tramp-rsh-end-of-line))))
+ (let ((result (tramp-unquote-shell-quote-argument s)))
(when (and (>= (length result) 2)
(string= (substring result 0 2) "\\~"))
(setq result (substring result 1)))
- (while (string-match nl result)
- (setq result (replace-match (format "'%s'" tramp-rsh-end-of-line)
- t t result)))
- result))))
+ (replace-regexp-in-string
+ (tramp-compat-rx "\\" (literal tramp-rsh-end-of-line))
+ (format "'%s'" tramp-rsh-end-of-line) result)))))
;;; Signal handling. This works for remote processes, which have set
;;; the process property `remote-pid'.
@@ -5880,40 +6621,60 @@ name of a process or buffer, or nil to default to the
current buffer."
(while (tramp-accept-process-output proc 0))
(not (process-live-p proc))))))
-;; `interrupt-process-functions' exists since Emacs 26.1.
-(when (boundp 'interrupt-process-functions)
- (add-hook 'interrupt-process-functions #'tramp-interrupt-process)
+(add-hook 'interrupt-process-functions #'tramp-interrupt-process)
+(add-hook
+ 'tramp-unload-hook
+ (lambda ()
+ (remove-hook 'interrupt-process-functions #'tramp-interrupt-process)))
+
+(defun tramp-signal-process (process sigcode &optional remote)
+ "Send PROCESS the signal with code SIGCODE.
+PROCESS may also be a number specifying the process id of the
+process to signal; in this case, the process need not be a child of
+this Emacs.
+If PROCESS is a process object which contains the property
+`remote-pid', or PROCESS is a number and REMOTE is a remote file name,
+PROCESS is interpreted as process on the respective remote host, which
+will be the process to signal.
+SIGCODE may be an integer, or a symbol whose name is a signal name."
+ (let (pid vec)
+ (cond
+ ((processp process)
+ (setq pid (process-get process 'remote-pid)
+ vec (process-get process 'vector)))
+ ((numberp process)
+ (setq pid process
+ vec (and (stringp remote) (tramp-dissect-file-name remote))))
+ (t (signal 'wrong-type-argument (list #'processp process))))
+ (unless (or (numberp sigcode) (symbolp sigcode))
+ (signal 'wrong-type-argument (list #'numberp sigcode)))
+ ;; If it's a Tramp process, send SIGCODE remotely.
+ (when (and pid vec)
+ (tramp-message
+ vec 5 "Send signal %s to process %s with pid %s" sigcode process pid)
+ ;; This is for tramp-sh.el. Other backends do not support this (yet).
+ (if (tramp-compat-funcall
+ 'tramp-send-command-and-check
+ vec (format "\\kill -%s %d" sigcode pid))
+ 0 -1))))
+
+;; `signal-process-functions' exists since Emacs 29.1.
+(when (boundp 'signal-process-functions)
+ (add-hook 'signal-process-functions #'tramp-signal-process)
(add-hook
'tramp-unload-hook
(lambda ()
- (remove-hook 'interrupt-process-functions #'tramp-interrupt-process))))
+ (remove-hook 'signal-process-functions #'tramp-signal-process))))
(defun tramp-get-remote-null-device (vec)
"Return null device on the remote host identified by VEC.
-If VEC is nil, return local null device."
- (if (null vec)
+If VEC is `tramp-null-hop', return local null device."
+ (if (equal vec tramp-null-hop)
null-device
(with-tramp-connection-property vec "null-device"
(let ((default-directory (tramp-make-tramp-file-name vec)))
(tramp-compat-null-device)))))
-(defmacro tramp-skeleton-delete-directory (directory recursive trash &rest
body)
- "Skeleton for `tramp-*-handle-delete-directory'.
-BODY is the backend specific code."
- (declare (indent 3) (debug t))
- `(with-parsed-tramp-file-name (expand-file-name ,directory) nil
- (if (and delete-by-moving-to-trash ,trash)
- ;; Move non-empty dir to trash only if recursive deletion was
- ;; requested.
- (if (not (or ,recursive (tramp-compat-directory-empty-p ,directory)))
- (tramp-error
- v 'file-error "Directory is not empty, not moving to trash")
- (move-file-to-trash ,directory))
- ,@body)
- (tramp-flush-directory-properties v localname)))
-
-(put #'tramp-skeleton-delete-directory 'tramp-suppress-trace t)
-
;; Checklist for `tramp-unload-hook'
;; - Unload all `tramp-*' packages
;; - Reset `file-name-handler-alist'
@@ -5952,5 +6713,11 @@ BODY is the backend specific code."
;; and friends, for most of the handlers this is the major
;; difference between the different backends. Other handlers but
;; *-process-file would profit from this as well.
+;;
+;; * Implement file name abbreviation for a different user. That is,
+;; (abbreviate-file-name "/ssh:user1@host:/home/user2") =>
+;; "/ssh:user1@host:~user2".
+;;
+;; * Implement file name abbreviation for user and host names.
;;; tramp.el ends here
diff --git a/trampver.el b/trampver.el
index 6567dea966..3682505946 100644
--- a/trampver.el
+++ b/trampver.el
@@ -7,8 +7,8 @@
;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; Package: tramp
-;; Version: 2.5.4
-;; Package-Requires: ((emacs "25.1"))
+;; Version: 2.6.0
+;; Package-Requires: ((emacs "26.1"))
;; Package-Type: multi
;; URL: https://www.gnu.org/software/tramp/
@@ -40,7 +40,7 @@
;; ./configure" to change them.
;;;###tramp-autoload
-(defconst tramp-version "2.5.4"
+(defconst tramp-version "2.6.0"
"This version of Tramp.")
;;;###tramp-autoload
@@ -52,9 +52,9 @@
;; Suppress message from `emacs-repository-get-branch'. We must
;; also handle out-of-tree builds.
(let ((inhibit-message t)
- (debug-on-error nil)
(dir (or (locate-dominating-file (locate-library "tramp") ".git")
- source-directory)))
+ source-directory))
+ debug-on-error)
;; `emacs-repository-get-branch' has been introduced with Emacs 27.1.
(with-no-warnings
(and (stringp dir) (file-directory-p dir)
@@ -67,23 +67,23 @@
;; Suppress message from `emacs-repository-get-version'. We must
;; also handle out-of-tree builds.
(let ((inhibit-message t)
- (debug-on-error nil)
(dir (or (locate-dominating-file (locate-library "tramp") ".git")
- source-directory)))
+ source-directory))
+ debug-on-error)
(and (stringp dir) (file-directory-p dir)
(executable-find "git")
(emacs-repository-get-version dir))))
"The repository revision of the Tramp sources.")
;; Check for Emacs version.
-(let ((x (if (not (string-lessp emacs-version "25.1"))
+(let ((x (if (not (string-version-lessp emacs-version "26.1"))
"ok"
- (format "Tramp 2.5.4 is not fit for %s"
+ (format "Tramp 2.6.0 is not fit for %s"
(replace-regexp-in-string "\n" "" (emacs-version))))))
(unless (string-equal "ok" x) (error "%s" x)))
(defun tramp-inside-emacs ()
- "Version string provided by INSIDE_EMACS enmvironment variable."
+ "Version string provided by INSIDE_EMACS environment variable."
(concat (or (getenv "INSIDE_EMACS") emacs-version)
",tramp:" tramp-version))
@@ -104,7 +104,8 @@
("2.3.3" . "26.1") ("2.3.3.26.1" . "26.1") ("2.3.5.26.2" . "26.2")
("2.3.5.26.3" . "26.3")
("2.4.3.27.1" . "27.1") ("2.4.5.27.2" . "27.2")
- ("2.5.2.28.1" . "28.1") ("2.5.3.28.2" . "28.2")))
+ ("2.5.2.28.1" . "28.1") ("2.5.3.28.2" . "28.2")
+ ("2.6.0.29.1" . "29.1")))
(add-hook 'tramp-unload-hook
(lambda ()
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] externals/tramp f1e00a4adb: Tramp ELPA version 2.6.0 released,
ELPA Syncer <=